convalidare una lista escludendo le voci ripetute
rick...@gmail.com
ho una lista in A:A contenente una serie di marchi.
vorrei poter convalidare questa lista facendo in modo che delle voci
ripetute me ne riporti solo una.é possibile?
altrimenti mi ritrovo nella casella di convalida molte voci uguali.
grazie infinite
Norman Jones
=============
=============
Se vuoi, potrei offrirti una soluzione VBA
Comunque, da Excel, potresti utilizzare il
Filtro Avvanzato per estrarre i valori unici
della colonna A in un'altra colonna, e poi
utilizzare questa lista filtrata per caricare la
Convalida Dati.
---
Regards.
Norman
rick...@gmail.com
wrote:
non ho mai usato il filtro avanzato ma potrei provarci.
se però con il VBA riesco a evitarmi una eventuale lista sarebbe
meglio.
poi darmi entrambe le soluzioni?
ti ringrazio molto
Norman Jones
=============
> Se vuoi, potrei offrirti una soluzione VBA
>
> Comunque, da Excel, potresti utilizzare il
> Filtro Avvanzato per estrarre i valori unici
> della colonna A in un'altra colonna, e poi
> utilizzare questa lista filtrata per caricare la
> Convalida Dati.
non ho mai usato il filtro avanzato ma potrei provarci.
se perň con il VBA riesco a evitarmi una eventuale lista sarebbe
meglio.
poi darmi entrambe le soluzioni?
=============
Per creare la lista de valori unici, partendo
(diciamo) dalla cella D1 sul Foglio1, iIn un
modulo standard (vedi di sotto), incolla:
'============>>
Option Explicit
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim srcRng As Range
Dim destRng
Dim rCell As Range
Dim iRow As Long
Dim oDic As Object
Const srcCol As String = "A:A" '<<=== da CAMBIARE
Const destCell As String = "D1" '<<=== da CAMBIARE
Set WB = Workbooks("Pipppo.xls") '<<=== da CAMBIARE
Set SH = WB.Sheets("Foglio1") '<<=== da CAMBIARE
With SH
iRow = lastrow(SH, .Range(srcCol))
Set srcRng = .Range("A1:A" & iRow)
Set destRng = .Range(destCell)
End With
Set oDic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each rCell In srcRng.Cells
With rCell
If Not IsEmpty(.Value) Then
oDic.Add Item:=.Value, Key:=CStr(.Value)
End If
End With
Next rCell
On Error GoTo 0
destRng.Resize(oDic.Count).Value = _
Application.Transpose(oDic.keys)
End Sub
'--------------->
Function lastrow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
lastrow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<============
Per utilizzare questa routine:
Alt-F11 per aprire l'Editor di VBA
Menu | Inserisci | Modulo
Incolla il suddetto codice
Alt-F11 per tornare in Excel
Alt-F8
Seleziona "Tester"
Esegui
Per utilizzare lo strumento Filtro Avvanzato
di Excel, prova:
Seleziona i dati nella colonna A
Menu | Dati | Filtro Avvanzato |
Copia a un'altra destinazione [x] |
Intervallo di Lista: Accetta l'indirizzo della tua selezione |
Intervallo Criteri [ ]
Valori unici [x]
Nella mia versione inglese, queste istruzioni sono:
Seleziona i dati nella colonna A
Menu | Dati | Filtro Avvanzato |
Copy to another location [x] |
List range: Accetta l'indirizzo della tua selezione |
Criteria range:Intervallo Criteri [ ]
Unique records only [x]
Se utilizzi VBA o il Filtro Avvanzato
per ottenere la lista dei valori unici,
potresti utilizzare questa lista per
caricare la Convalida Dati
Ovviamente, sarebbe possibile utilizzare
il Filtro Avvanzato da VBA e, sapendo
l'intervallo di interesse, sarebbe possibile
impostare la Convalida Dati
automaticamente.
---
Regards.
Norman
rick...@gmail.com
wrote:
> Ciao Ricky,
>
> =============
>
> > Se vuoi, potrei offrirti una soluzione VBA
>
> > Comunque, da Excel, potresti utilizzare il
> > Filtro Avvanzato per estrarre i valori unici
> > della colonna A in un'altra colonna, e poi
> > utilizzare questa lista filtrata per caricare la
> > Convalida Dati.
>
> non ho mai usato il filtro avanzato ma potrei provarci.
veramente molto ma molto gentile. ti ringrazio. in questi giorni
proverò quello piu comodo.
Pippo
[cut]
> Se utilizzi VBA o il Filtro Avvanzato
> per ottenere la lista dei valori unici,
> potresti utilizzare questa lista per
> caricare la Convalida Dati
>
> Ovviamente, sarebbe possibile utilizzare
> il Filtro Avvanzato da VBA e, sapendo
> l'intervallo di interesse, sarebbe possibile
> impostare la Convalida Dati
> automaticamente.
Scusa Norman, per gestire da Vb il "Filtro Avanzato" al fine di
ottenere una lista unica per la convalida, occorre una colonna di
appoggio?
Grazie milleeee
--
Ciao a tutti
Pippo
Norman Jones
=============
veramente molto ma molto gentile. ti ringrazio. in questi giorni
proverņ quello piu comodo.
=============
Se dovessi incontrare problemi, o se
vuoi impostare la Convalida Dati
automaticamente, siamo sempre qui.
---
Regards.
Norman
Norman Jones
=============
Scusa Norman, per gestire da Vb il "Filtro Avanzato" al fine di
ottenere una lista unica per la convalida, occorre una colonna di
appoggio?
=============
Non sono sicuro di avere capito la tua
domanda ma il Filtro Avvanzato, che sia
gestito da Excel che da VBA, non richiede
una colonna di appogio; i risultati del filtro
possano essere restituiti sia nell'intervallo
orginario che altrove.
Forse ti riferisci ad un'altro aspetto della
questione?
---
Regards.
Norman
Pippo
> =============
> Scusa Norman, per gestire da Vb il "Filtro Avanzato" al fine di ottenere una
> lista unica per la convalida, occorre una colonna di appoggio?
> =============
>
> Non sono sicuro di avere capito la tua domanda ma il Filtro Avvanzato, che
> sia gestito da Excel che da VBA, non richiede una colonna di appogio; i
> risultati del filtro
> possano essere restituiti sia nell'intervallo orginario che altrove.
Volendo lasciare *inalterato* l'elenco originario, ho bisogno di far
restituire i valori unici, in un altro intervallo, quindi, mi occorre
una colonna di appoggio.
*Esempio*
Nell'intervallo "A1:A10", ho la mia lista con elementi che si ripetono,
in un altro intervallo, es. "D1:D10"(colonna di appoggio di lunghezza
variabile), tramite il filtro avanzato (Unique records only [x])ottengo
l'elenco senza ripetizioni.
Usando poi la "convalida"(es. nell'intervallo E1:E10), la faccio
"puntare" all'elenco di valori unici in "D1:D10".
Chiedevo, se era possibile, tramite Vb(*o altro sistema*), inserire la
convalida (nell'intervallo "E1:E10") senza ricorrere alla colonna di
appoggio "D1:D10".
..forse, occorrerebbe inserire una opportuna *formula* in "convalida"
che, puntando *direttamente* all'elenco iniziale e con ripetizioni,
posizionato in "A1:A10", ne *estrae* i dati con valori unici...
Spero di essere stato un pochino piu' chiaro.. ;-))
Grazie milleeeeee
Pippo
> Il 07/06/2008, Norman Jones ha detto :
[cut]
> *Esempio*
>
> Nell'intervallo "A1:A10", ho la mia lista con elementi che si ripetono, in un
> altro intervallo, es. "D1:D10"(colonna di appoggio di lunghezza variabile),
> tramite il filtro avanzato (Unique records only [x])ottengo l'elenco senza
> ripetizioni.
>
> Usando poi la "convalida"(es. nell'intervallo E1:E10), la faccio "puntare"
> all'elenco di valori unici in "D1:D10".
>
> Chiedevo, se era possibile, tramite Vb(*o altro sistema*), inserire la
> convalida (nell'intervallo "E1:E10") senza ricorrere alla colonna di appoggio
> "D1:D10".
> ..forse, occorrerebbe inserire una opportuna *formula* in "convalida" che,
> puntando *direttamente* all'elenco iniziale e con ripetizioni, posizionato in
> "A1:A10", ne *estrae* i dati con valori unici...
Per il predetto scopo, stavo dando uno sguardo alle interessanti
formule matriciali proposte da "Barbara":
.. ma, se NON ho commesso errori, NON credo possano essere inserite
come "formule" da utilizzare in "Convalida"...
Pippo
>> *Esempio*
>>
>> Nell'intervallo "A1:A10", ho la mia lista con elementi che si ripetono, in
>> un altro intervallo, es. "D1:D10"(colonna di appoggio di lunghezza
>> variabile), tramite il filtro avanzato (Unique records only [x])ottengo
>> l'elenco senza ripetizioni.
>>
>> Usando poi la "convalida"(es. nell'intervallo E1:E10), la faccio "puntare"
>> all'elenco di valori unici in "D1:D10".
>>
>> Chiedevo, se era possibile, tramite Vb(*o altro sistema*), inserire la
>> convalida (nell'intervallo "E1:E10") senza ricorrere alla colonna di
>> appoggio "D1:D10".
>
>
>> ..forse, occorrerebbe inserire una opportuna *formula* in "convalida" che,
>> puntando *direttamente* all'elenco iniziale e con ripetizioni, posizionato
>> in "A1:A10", ne *estrae* i dati con valori unici...
>
> Per il predetto scopo, stavo dando uno sguardo alle interessanti formule
> matriciali proposte da "Barbara":
>
> http://tinyurl.com/59z2ek
>
> .. ma, se NON ho commesso errori, NON credo possano essere inserite come
> "formule" da utilizzare in "Convalida"...
Ho trovato il seguente codice di Fernando, pero', i dati filtrati(*a
differenza di quanto spiegato da Fernando*), NON vengono *ordinati*:
Riporto, il codice di Fernando, al predetto link:
'======================================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim unici As New Collection, x As Range
Dim j As Long, alfa As String, myrange As Range, myvalid As Range
Set myrange = Range("A1:A10")
Set myvalid = Range("B1")
If Application.Intersect(Target, myvalid) Is Nothing Then Exit Sub
On Error Resume Next
For Each x In myrange
If x <> "" Then unici.Add x, x.Text
Next x
For j = 1 To unici.Count
alfa = alfa & unici(j) & ","
Next j
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="" & alfa & ""
End With
End Sub
'======================================================================
E' possibile ottenere anche l'ordinamento? ;-))
Norman Jones
=============
Volendo lasciare *inalterato* l'elenco originario, ho bisogno di far
restituire i valori unici, in un altro intervallo, quindi, mi occorre
una colonna di appoggio.
*Esempio*
Nell'intervallo "A1:A10", ho la mia lista con elementi che si ripetono,
in un altro intervallo, es. "D1:D10"(colonna di appoggio di lunghezza
variabile), tramite il filtro avanzato (Unique records only [x])ottengo
l'elenco senza ripetizioni.
Usando poi la "convalida"(es. nell'intervallo E1:E10), la faccio
"puntare" all'elenco di valori unici in "D1:D10".
Chiedevo, se era possibile, tramite Vb(*o altro sistema*), inserire la
convalida (nell'intervallo "E1:E10") senza ricorrere alla colonna di
appoggio "D1:D10".
..forse, occorrerebbe inserire una opportuna *formula* in "convalida"
che, puntando *direttamente* all'elenco iniziale e con ripetizioni,
posizionato in "A1:A10", ne *estrae* i dati con valori unici...
- - - - -
Per il predetto scopo, stavo dando uno sguardo alle interessanti
formule matriciali proposte da "Barbara":
.. ma, se NON ho commesso errori, NON credo possano essere inserite
come "formule" da utilizzare in "Convalida"...
- - - - -
'======================================================================
E' possibile ottenere anche l'ordinamento? ;-))
=============
Chiedo scusa per il ritardo con cui
rispondo ma, ho dovuto uscire.
In un modulo standard (vedi di sotto),
incolla la seguente funzione:
'============>>
Function LastRow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<============
Alt-F11 per aprire l'Editor di VBA
Menu | Inserisci | Modulo
Incolla il suddetto codice
Alt-F11 per tornare in Excel
N el modulo del foglio (vedi di sotto),
incolla:
'========>>
Option Explicit
'-------------->>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oDic As Object
Dim i As Long, j As Long
Dim iRow As Long
Dim sStr As String
Dim Rng As Range
Dim Rng2 As Range
Dim rCell As Range
Dim swap1 As Variant
Dim swap2 As Variant
Dim arrKeys As Variant
With Me
iRow = LastRow(Me, Range("A:A"))
Set Rng = .Range("A2:A" & iRow)
Set Rng2 = .Range("B1:B20") '<<=== da CAMBIARE
End With
If Application.Intersect(Target, Rng) Is Nothing Then
Exit Sub
End If
Set oDic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each rCell In Rng.Cells
With rCell
If Not IsEmpty(.Value) Then
oDic.Add Item:=.Value, Key:=CStr(.Value)
End If
End With
Next rCell
arrKeys = oDic.keys
With arrKeys
For i = LBound(arrKeys) To UBound(arrKeys) - 1
For j = i + 1 To UBound(arrKeys)
If arrKeys(i) > arrKeys(j) Then
swap1 = arrKeys(i)
swap2 = arrKeys(j)
arrKeys(i) = swap2
arrKeys(j) = swap1
End If
Next j
Next i
End With
For j = 1 To oDic.Count
sStr = sStr & arrKeys(j) & ","
Next j
With Rng2.Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="" & sStr & ""
End With
End Sub
'<<========
Si tratta d una routine di evento Worksheet_Change.
Per utilizzarla, con il tasto destro del mouse fai click
sulla linguetta del foglio, scegli "Visualizza codice" e
nella finestra del codice incolla la routine.
Alt-F11 per tornare in Excel
Come scritto, si trova il dati originale
nella colonna A e la routine d'evento
imposta la Convalida Dati all'intervallo
B1:B20.
La routine risponda al cambiamento
di un valore nella colonna A per
aggiornare e ordinare i dati utilizzati dalla
Pippo
[cut]
uhm...ed io che avevo pensato di averti messo in difficolta'! :-))
..cmq NON devi scusarti, fai gia' molto per noi *neofiti*! ;-)
Nell'attesa della tua risposta, avevo trovato sul sito "microsoft", la
seguente funzione di ordinamento:
'========================================================
Function BubbleSort(TempArray As Variant)
Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer
' Loop until no more "exchanges" are made.
Do
NoExchanges = True
' Loop through each element in the array.
For i = 1 To UBound(TempArray) - 1
' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) > TempArray(i + 1) Then
NoExchanges = False
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)
End Function
'==================================================================
...NON sono riuscito pero', a passare, alla suddetta funzione, la
collezione "unici", del codice scritto da Fernando.
Puoi darmi un aiuto?
GRAZIE MILLE!
Pippo
[cut]
'========================================================
End Function
'==================================================================
Puoi darmi un aiuto?
GRAZIE MILLE!
--
Ciao a tutti
Pippo
Norman Jones
===========
[...]
Nell'attesa della tua risposta, avevo trovato sul sito "microsoft", la
seguente funzione di ordinamento:
'========================================================
Function BubbleSort(TempArray As Variant)
Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer
' Loop until no more "exchanges" are made.
Do
NoExchanges = True
' Loop through each element in the array.
For i = 1 To UBound(TempArray) - 1
' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) > TempArray(i + 1) Then
NoExchanges = False
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)
End Function
...NON sono riuscito pero', a passare, alla suddetta funzione, la
collezione "unici", del codice scritto da Fernando.
Puoi darmi un aiuto?
===========
Non sei un neofita e, pertanto, mi ricordo
la vecchia massima:
Se date ad un uomo affamato un pesce,
avrà una cena; se insegnate all'uomo a
pescare, mangierà per tutta la vita.
Quindi prova come segue e. se dovessi
incontrare degli problemi, ho ancora
alcuni pesci qui!
Dimenensiona un Array come Variant
Carica l'array con i dati della Collection
tramite un For .. Next loop
Passa l'array alla funzione BubbleSort.
A proposito, io avevo utilizzato un
Dictionary perche' mi permetteva di s
fruttare il suo array di keys ( o items).
---
Regards.
Norman
Norman Jones
=============
[...]
Puoi darmi un aiuto?
=============
Sempre - ma in questo caso vedi la
mia risposta al tuo post precedente!
---
Regards.
Norman
Norman Jones
--
=============
[..]
> Chiedo scusa per il ritardo con cui rispondo ma, ho dovuto uscire.
[cut]
uhm...ed io che avevo pensato di averti messo in difficolta'! :-))
[...]
=============
Non sarebbe mica difficile di farlo!
Tuttavia, in questo caso non sei riuscito!
Se cerca gli archivi del gruppo, dovresti
trovare numerosi thread, da me,
riguardante l'ordinamento delle Collection,
i Dictionary e gli Array; il codice per la
Convalida Dati ti ha già fornito Fernando
---
Regards.
Norman
Pippo
VERO!
> Quindi prova come segue e. se dovessi
> incontrare degli problemi, ho ancora
> alcuni pesci qui!
OK!
> Dimenensiona un Array come Variant
> Carica l'array con i dati della Collection
> tramite un For .. Next loop
>
> Passa l'array alla funzione BubbleSort.
OK,.. ho apportato le seguenti modifiche:
'==================================================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim unici As New Collection, x As Range
Dim j As Long, alfa As String, myrange As Range, myvalid As Range
Dim n As Long
Dim u() As Variant
Set myrange = Range("A1:A10")
Set myvalid = Range("B1")
If Application.Intersect(Target, myvalid) Is Nothing Then Exit Sub
On Error Resume Next
For Each x In myrange
If x <> "" Then unici.Add x, x.Text
Next x
n = unici.Count
ReDim u(1 To n)
For j = 1 To n
u(j) = unici(j)
Next j
BubbleSort u
For j = 1 To n
alfa = alfa & u(j) & ","
Next j
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,
Operator:= _
xlBetween, Formula1:="" & alfa & ""
End With
End Sub
'=======================================================================
Sembra funzionare,.. si possono apportare ulteriori miglioramenti? ;-))
> A proposito, io avevo utilizzato un
> Dictionary perche' mi permetteva di s
> fruttare il suo array di keys ( o items).
Adesso, credo proprio di averne capito l'utilita'! ;-))
Grazie milleeeee!
Norman Jones
========>>
Se cerchi gli archivi del gruppo, dovresti
Credo che diventi tardi! -:)
---
Regards.
Norman
Norman Jones
--
=============
VERO!
OK!
'==================================================================
n = unici.Count
ReDim u(1 To n)
u(j) = unici(j)
Next j
BubbleSort u
End Sub
Sembra funzionare,.. si possono apportare ulteriori miglioramenti? ;-))
=============
Allora, hai realizzato perfettamente le
mie istruzioni schematiche ed sei riuscito
a raggiungere il tuo obiettivo; ora hai una
lista in ordine alfabetico dei valori unici
per utilizzare come la fonte per la c
onvalida di dati.
Bravo! Hai visto che non era tanto difficile?
=============
> A proposito, io avevo utilizzato un
> Dictionary perche' mi permetteva di s
> fruttare il suo array di keys ( o items).
Adesso, credo proprio di averne capito l'utilita'! ;-))
=============
Ottima; l'oggetto Dictionary e' utilissimo.
---
Regards.
Norman
Norman Jones
=============
VERO!
OK!
'==================================================================
n = unici.Count
ReDim u(1 To n)
u(j) = unici(j)
Next j
BubbleSort u
End Sub
Sembra funzionare,.. si possono apportare ulteriori miglioramenti? ;-))
[...]
=============
Per quanto riguarda dei migliormenti, nella
tua funzione BubbleSort, prova a sostituire:
> Dim i As Integer
> Dim NoExchanges As Integer
con
Dim i As Long
Dim NoExchanges As Boolean
Inoltre, perche' utilizzi l'evento
Worksheet_SelectionChange, i dati devono
essere ricaricati e riordinati ogni volta che
l'utente seleziona una delle celle della
Convalida Dati; credo, in questo caso, sia
piu' efficiente sfruttare l'evento
Worksheet_Change in modo che i dati
siano ricaricati e riordinati soltanto quando
un dato sia cambiato.
Al questo riguardo, potresti notare un
esempio dell' uso dell'evento
Worksheet_Change nel codice che ho
postato in questo thread.
---
Regards.
Norman
Pippo
> Ciao Pippo,
>
> =============
> Volendo lasciare *inalterato* l'elenco originario, ho bisogno di far
> restituire i valori unici, in un altro intervallo, quindi, mi occorre una
> colonna di appoggio.
>
> *Esempio*
>
> Nell'intervallo "A1:A10", ho la mia lista con elementi che si ripetono, in un
> altro intervallo, es. "D1:D10"(colonna di appoggio di lunghezza variabile),
> tramite il filtro avanzato (Unique records only [x])ottengo l'elenco senza
> ripetizioni.
>
> Usando poi la "convalida"(es. nell'intervallo E1:E10), la faccio "puntare"
> all'elenco di valori unici in "D1:D10".
>
> Chiedevo, se era possibile, tramite Vb(*o altro sistema*), inserire la
> convalida (nell'intervallo "E1:E10") senza ricorrere alla colonna di appoggio
> "D1:D10".
[cut]
Ho fatto qualche prova, ed ho notato che, l'ultimo elemento del range
"A2:A" & iRow
..NON viene incluso nella convalida.
Inoltre, quando il predetto intervallo e' "vuoto",
iRow=0
quindi:
Set Rng = .Range("A2:A" & iRow)
..genera un errore.
Qual'e' il modo ottimale per risolvere i suddetti problemi?
Grazie milleeeeeeee
Pippo
[cut]
> End Sub
>
>
> Sembra funzionare,.. si possono apportare ulteriori miglioramenti? ;-))
>
> [...]
> =============
>
> Per quanto riguarda dei migliormenti, nella
> tua funzione BubbleSort, prova a sostituire:
>
>> Dim i As Integer
>> Dim NoExchanges As Integer
>
> con
>
> Dim i As Long
> Dim NoExchanges As Boolean
OK!
> Inoltre, perche' utilizzi l'evento
> Worksheet_SelectionChange, i dati devono
> essere ricaricati e riordinati ogni volta che
> l'utente seleziona una delle celle della
> Convalida Dati; credo, in questo caso, sia
> piu' efficiente sfruttare l'evento
> Worksheet_Change in modo che i dati
> siano ricaricati e riordinati soltanto quando
> un dato sia cambiato.
*Giustissimo*,.. NON avevo fatto caso che, la routine, era stata
associata all'evento "Worksheet_SelectionChange":sara' stata una svista
di Fernando? ;-))
> Al questo riguardo, potresti notare un
> esempio dell' uso dell'evento
> Worksheet_Change nel codice che ho
> postato in questo thread.
Ho dato uno sguardo alla tua routine ed ho fatto alcune osservazioni
che troverai evidenziate, in un mio post di risposta alla tua routine,
in questo stesso thread.
Grazie mille per la disponibilita' e competenza!
Pippo
..volevo dire il *primo elemento*..
ho provato a modificare
For j = 1 To oDic.Count
con
For j = 0 To oDic.Count
..e sembra funzionare
> Inoltre, quando il predetto intervallo e' "vuoto",
>
> iRow=0
>
> quindi:
>
> Set Rng = .Range("A2:A" & iRow)
>
> ..genera un errore.
>
> Qual'e' il modo ottimale per risolvere i suddetti problemi?
Confermo il problema relativo all'intervallo "vuoto"...
Grazie milleeee
Pippo
oppure, sostituendo:
'===========================================
For j = 1 To oDic.Count
sStr = sStr & arrKeys(j) & ","
Next j
'===========================================
con:
'===========================================
For j = LBound(arrKeys) To UBound(arrKeys)
sStr = sStr & arrKeys(j) & ","
Next j
'===========================================
Norman Jones
=============
Ho fatto qualche prova, ed ho notato che, l'ultimo elemento del range
"A2:A" & iRow
..NON viene incluso nella convalida.
Inoltre, quando il predetto intervallo e' "vuoto",
iRow=0
quindi:
Set Rng = .Range("A2:A" & iRow)
..genera un errore.
Qual'e' il modo ottimale per risolvere i suddetti problemi?
=============
Il modo ottimale sarebbe di scrivere
una routine piu' robusta!
Devo ammettere che non avevo pensato
della possibilita' di un elenco di convalida
vuoto.
Il fatto che ci sia stato un valore mancante
nell'elenco convalida e' dovuto al fatto che
il metodo Keys restiuisce un l'array del tipo
zero-base.
Ho modificato la mia routine per affrontare
questi punti e anche per gestire la posisbilta'
che l'elenco comprendesse valori minuscoli,
maiuscoli e una combinazione di minusculo
e maiuscolo; ad esempio:
Names
Freda
Anita
ANNE
TOM
Carol
Ben
david
Anita
john
Anne
anne
Quindi. prova a sostituire la routinr di evento
con la seguente versione:
'========>>
Option Explicit
'-------------->>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oDic As Object
Dim i As Long, j As Long
Dim iRow As Long
Dim sStr As String
Dim Rng As Range
Dim Rng2 As Range
Dim rCell As Range
Dim swap1 As Variant
Dim swap2 As Variant
Dim arrKeys As Variant
Dim arrItems As Variant
With Me
Set Rng2 = .Range("B1:B6") '<<=== da CAMBIARE
iRow = LastRow(Me, Range("A:A"))
If iRow = 0 Then
GoTo XIT
End If
Set Rng = .Range("A2:A" & iRow)
End With
If Application.Intersect(Target, Rng) Is Nothing Then
Exit Sub
End If
Set oDic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each rCell In Rng.Cells
With rCell
If Not IsEmpty(.Value) Then
oDic.Add _
Item:=StrConv(.Value, vbProperCase), _
Key:=StrConv(CStr(.Value), vbProperCase)
End If
End With
Next rCell
arrKeys = oDic.keys
With arrKeys
For i = LBound(arrKeys) To UBound(arrKeys) - 1
For j = i + 1 To UBound(arrKeys)
If arrKeys(i) > arrKeys(j) Then
swap1 = arrKeys(i)
swap2 = arrKeys(j)
arrKeys(i) = swap2
arrKeys(j) = swap1
End If
Next j
Next i
End With
For j = 0 To oDic.Count
sStr = sStr & arrKeys(j) & ","
Next j
' On Error Resume Next
With Rng2.Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="" & sStr & ""
End With
Exit Sub
XIT:
Rng2.Validation.Delete
End Sub
'<<========
---
Regards.
Norman
Norman Jones
=============
[..]
*Giustissimo*,.. NON avevo fatto caso che, la routine, era stata
associata all'evento "Worksheet_SelectionChange":sara' stata una svista
di Fernando? ;-))
[..]
=============
No, non ci credo.
Senza approfindire quel vecchio thread
troppo, penso che l'obiettivo principale
di Fernando era di dimostrare un metodo
per aggiornare, dinamicamente, una lista di
convalida di dati, in cui la lista dovrebbe
limitarsi ai valori unici senza valori vuoti.
---
Regards.
Norman
Pippo
>
> =============
> Ho fatto qualche prova, ed ho notato che, l'ultimo elemento del range
>
> "A2:A" & iRow
>
> ..NON viene incluso nella convalida.
>
> Inoltre, quando il predetto intervallo e' "vuoto",
>
> iRow=0
>
> quindi:
>
> Set Rng = .Range("A2:A" & iRow)
>
> ..genera un errore.
>
> Qual'e' il modo ottimale per risolvere i suddetti problemi?
>
> =============
>
> Il modo ottimale sarebbe di scrivere una routine piu' robusta!
OK!
OK, ho delle prove e funziona benissimo.
Un'ultima domanda(forse ... :-) ..)..
Nella seguente parte di codice
'==============================================
'......
Set oDic = CreateObject("Scripting.Dictionary")
On Error Resume Next
'.......
'===============================================
.. l'istruzione "On Error Resume Next", e' ancora necessaria?
Grazie milleeeeeee
Norman Jones
=============
.. l'istruzione "On Error Resume Next", e' ancora necessaria?
=============
No, anche se non fa niente di male, non
e' necessario. (reliquia di una versione intermedia)
Ho approfittato per cancellare la variabile:
> Dim arrKeys As Variant
(reliquia di una versione intermedia
e per sostituire:
> Next rCell
con
Next rCell
On Error GoTo 0
Quindi, prova:
'========>>
Option Explicit
'-------------->>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oDic As Object
Dim i As Long, j As Long
Dim iRow As Long
Dim sStr As String
Dim Rng As Range
Dim Rng2 As Range
Dim rCell As Range
Dim swap1 As Variant
Dim swap2 As Variant
Dim arrKeys As Variant
With Me
Set Rng2 = .Range("B1:B6") '<<=== da CAMBIARE
iRow = LastRow(Me, Range("A:A"))
If iRow = 0 Then
GoTo XIT
End If
Set Rng = .Range("A2:A" & iRow)
End With
If Application.Intersect(Target, Rng) Is Nothing Then
Exit Sub
End If
Set oDic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each rCell In Rng.Cells
With rCell
If Not IsEmpty(.Value) Then
oDic.Add _
Item:=StrConv(.Value, vbProperCase), _
Key:=StrConv(CStr(.Value), vbProperCase)
End If
End With
Next rCell
On Error GoTo 0
arrKeys = oDic.keys
With arrKeys
For i = LBound(arrKeys) To UBound(arrKeys) - 1
For j = i + 1 To UBound(arrKeys)
If arrKeys(i) > arrKeys(j) Then
swap1 = arrKeys(i)
swap2 = arrKeys(j)
arrKeys(i) = swap2
arrKeys(j) = swap1
End If
Next j
Next i
End With
For j = 0 To oDic.Count
sStr = sStr & arrKeys(j) & ","
Next j
With Rng2.Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="" & sStr & ""
End With
Exit Sub
XIT:
Rng2.Validation.Delete
End Sub
'<<========
---
Regards.
Norman
Pippo
Per risolvere il problema dell'indice inferiore per l'array "arrKeys",
si potrebbe sostituire la seguente istruzione:
'===========================================
For j = 0 To oDic.Count
sStr = sStr & arrKeys(j) & ","
Next j
'===========================================
con:
'===========================================
For j = LBound(arrKeys) To UBound(arrKeys)
sStr = sStr & arrKeys(j) & ","
Next j
'===========================================
Cosa ne pensi?
Grazie milleeeeee
Maurizio Borrelli
news:40afb9de-4d80-4a09...@34g2000hsf.googlegroups.com:
> ho una lista in A:A contenente una serie di marchi.
> vorrei poter convalidare questa lista facendo in modo che delle voci
> ripetute me ne riporti solo una.é possibile?
> altrimenti mi ritrovo nella casella di convalida molte voci uguali.
Ciao rickypoz.
Un modo, forse macchinoso ma dinamico, che ha il dubbio/indubbio
vantaggio di non richiedere codice, potrebbe essere il seguente:
| | A |
+---+---------+
| 1|Pippo |
| 2|Pluto |
| 3|Paperino |
| 4|Topolino |
| 5|Pippo |
| 6|Pluto |
| 7|Paperino |
| 8|Topolino |
| 9|Qui |
| 10|Pippo |
| 11|Pluto |
\Dati/
| | A | B | C | D |
+---+----+---------+---+---------+
| 1| 1 |Pippo | 2 |Paperino |
| 2| 2 |Pluto | 3 |Pippo |
| 3| 3 |Paperino | 1 |Pluto |
| 4| 4 |Topolino | 5 |Qui |
| 5| |Qui | 4 |Topolino |
| 6| | #NUM! | 1 | #N/D |
| 7| | #NUM! | 1 | #N/D |
| 8| | #NUM! | 1 | #N/D |
| 9| 9 | #NUM! | 1 | #N/D |
| 10| | #NUM! | 1 | #N/D |
| 11| | #NUM! | 1 | #N/D |
| 12| | #NUM! | 1 | #N/D |
| 13| | #NUM! | 1 | #N/D |
| 14| | #NUM! | 1 | #N/D |
| 15| | #NUM! | 1 | #N/D |
| 16| | #NUM! | 1 | #N/D |
| 17| | #NUM! | 1 | #N/D |
| 18| | #NUM! | 1 | #N/D |
| 19| | #NUM! | 1 | #N/D |
| 20| | #NUM! | 1 | #N/D |
\Appoggio per convalida/
Formule:
[A1]
=SE(VAL.VUOTO(Dati!$A$1:A1);"";SE(CONTA.SE(Dati!$A$1:A1;"="&Dati!$A$1:A1)=1;RIF.RIGA();""))
[B1] =INDICE(Dati!$A$1:$A$20;PICCOLO($A$1:$A$20;RIF.RIGA()))
[C1] =CONTA.SE(SCARTO($B$1;0;0;CONTA.NUMERI($A$1:$A$20));"<"&B1)+1
[D1] =INDICE($B$1:$B$20;CONFRONTA(RIF.RIGA();$C$1:$C$20;0))
(Tutte da ricopiare in basso fino alla riga 20.)
Nomi definiti:
[Lista]
=SCARTO('Appoggio per convalida'!$D$1;0;0;CONTA.NUMERI('Appoggio per
convalida'!$A$1:$A$20))
Convalida dati:
Consenti: Elenco
Origine: =Lista
(Facci sapere se e eventualmente come hai risolto. Grazie!)
--
Ciao!
Maurizio Borrelli [Microsoft MVP Office System]
http://www.riolab.org/
Pippo
Inoltre, stavo ripensando alla routine di *Fernando* che utilizzava
l'evento "Worksheet_SelectionChange" invece dell'evento
"Worksheet_Change":
se ho *gia'* il mio elenco di dati con ripetizione nell'intervallo
"A:A", creato *prima* di inserire la macro associata invece all'evento
"Worksheet_Change", facendo clic direttamente nell'intervallo di
convalida "B:B", l'evento "Worksheet_Change" NON si attivera' e di
conseguenza le convalide NON verranno create...
Cosa ne pensi? ;-)
Norman Jones
Non avevo visto il tuo post precedente
perche' non mi e' visibile da WindowsMail.
Tuttavia, appprofitto ora per rispondere
ad entrambi post ora.
=============
> Per risolvere il problema dell'indice inferiore per l'array "arrKeys", si
> potrebbe sostituire la seguente istruzione:
> For j = 0 To oDic.Count
> sStr = sStr & arrKeys(j) & ","
> Next j
> con:
> For j = LBound(arrKeys) To UBound(arrKeys)
> sStr = sStr & arrKeys(j) & ","
> Next j
Inoltre, stavo ripensando alla routine di *Fernando* che utilizzava
l'evento "Worksheet_SelectionChange" invece dell'evento
"Worksheet_Change":
se ho *gia'* il mio elenco di dati con ripetizione nell'intervallo
"A:A", creato *prima* di inserire la macro associata invece all'evento
"Worksheet_Change", facendo clic direttamente nell'intervallo di
convalida "B:B", l'evento "Worksheet_Change" NON si attivera' e di
conseguenza le convalide NON verranno create...
Cosa ne pensi? ;-)
=============
Nel modulo ThisWorkbook, incolla:
'========>>
Option Explicit
Private Sub Workbook_Open()
Dim SH As Worksheet
Set SH = Me.Sheets("Foglio1")
With SH.Range("A:A")
.Value = .Value
End With
End Sub
'<<========
Nell modulo del foglio, incolla:
'========>>
Option Explicit
arrKeys = oDic.keys
For i = LBound(arrKeys) To UBound(arrKeys) - 1
For j = i + 1 To UBound(arrKeys)
If arrKeys(i) > arrKeys(j) Then
swap1 = arrKeys(i)
swap2 = arrKeys(j)
arrKeys(i) = swap2
arrKeys(j) = swap1
End If
Next j
sStr = sStr & arrKeys(i) & ","
Next i
sStr = sStr & arrKeys(i) & ","
With Rng2.Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=sStr
End With
Exit Sub
XIT:
Rng2.Validation.Delete
End Sub
'<<========
Salva, chiudi e riapri il workkbook o, in
alternativa, avvia la routine Workbook_Ope.
---
Regards.
Norman
Norman Jones
Per evitare confusione:
> alternativa, avvia la routine Workbook_Ope.
====>>
alternativa, avvia la routine Workbook_Open.
---
Regards.
Norman
Pippo
> Non avevo visto il tuo post precedente
> perche' non mi e' visibile da WindowsMail.
Io ho abbndonato "WindowsMail" in quanto mi ha dato molti problemi e
sono passato a "MesNews": ne sono mooolto soddisfatto! ;-))
> Tuttavia, appprofitto ora per rispondere
> ad entrambi post ora.
OK! Grazie!
Ho fatto qualche prova, c'e' ancora un problema:
In A2 scrivo "Norman".
In A3 scrivo "Pippo".
Le altre celle dell'intervallo "A4:A65536" sono tutte vuote.
La convalida in B2 e' OK: mi mostra entrambi in nomi.
Cancello "Pippo" in A3 e, la "convalida", in B2, mi mostra,
ERRONEAMENTE, *ancora* *entrambi* i nomi.
Cosa succede?
Quando cancello il valore in A3(cella *sottostante* la A2),
l'intervallo calcolato diventa:
'===========================================
Set Rng = .Range("A2:A" & iRow) => "A2:A2"
'===========================================
*ma*, il range "Target", e' pari ad A3(cella in cui cancello il dato):
'====================================================
Target=>A3
'====================================================
quindi, le seguenti istruzioni, provocano l'uscita dalla sub:
'=======================================================
If Application.Intersect(Target, Rng) Is Nothing Then
Exit Sub
End If
'========================================================
...ed il conseguente mancato aggiornamento della "convalida".
Si puo' risolvere? ;-))
Grazie milleeeeeee
Norman Jones
=============
[...]
Ho fatto qualche prova, c'e' ancora un problema:
[...]
=============
Prova a sostituire:
Set Rng = .Range("A2:A" & iRow)
con
Set Rng = .Range("A2:A" & iRow + 1)
---
Regards.
Norman
Pippo
Tutto OK! ;-))
Grazie mille per la tempestivita' della risposta!