VBA: Popolare una list box con valori univoci

[draleo]

Bentornato Norman. E’ un grande piacere risentirti.
Trattasi di una vecchia procedura di Norman, che serve a popolare la list box2 con valori univoci , presi dalla colonna G del foglio attivo e utilizzando una funzione , che richiama una tab Pivot
E’ velocissima e funziona benissimo , a condizione che i nomi estratti con la tab pivot siano più di uno
Ma se invece, nella tab pivot, c’è un solo nome, allora dà errore: errore di run time 381: impossibile impostare la proprietà list. Indice della matrice non valido
Come si può correggere tale errore ?
grazie
draleo

Private Sub ListBox1_Click()
......
Lrow = Cells(Rows.Count, "G").End(xlUp).Row
UserForm2.ListBox2.List = Unique_With_Pivot(Range("G12:G" & Lrow)) 'creo le item della listbox2 ordinate
......
End sub
Function Unique_With_Pivot(rng As Excel.Range)
Dim r As Excel.Range, sPFName As String
Dim PC As PivotCache, PT As PivotTable
Set r = rng.Parent.Parent.Worksheets.Add.[a3]
sPFName = rng(1).Value
Set PC = rng.Parent.Parent.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rng.Address(, , , True))
Set PT = r.Parent.PivotTables.Add(PC, r, "tabella_pivot_x")
With PT.PivotFields(sPFName)
.Orientation = xlRowField
.Position = 1
Unique_With_Pivot = .DataRange.Value
End With
Application.DisplayAlerts = False
r.Parent.Delete
Application.DisplayAlerts = True
End Function

[Norman Jones]

Ciao Draleo,

Ti ringrazio per il tuo saluto gentilissimo!

Tuo problema è dovuto al fatto che la proprietà Listbox richiede che una
matrice a 2 dimensioni sia passato dalla tabella pivot. Se, tuttavia, il
pivot dovesse restituire solo un valore singolo, non esiste alcun
matrice e, come hai visto, un 'run-time' errore 381 viene restituito.

Ho quindi adattato il codice per evitare l'errore e caricare la listbox
con un valore singolo o una matrice di valori, secondo i risultati della
tabella pivot.

NB: la nuova variabile, myVar, deve essere posizionato nella parte
superiore del modulo, prima di qualsiasi codice.

---
Regards,
Norman

[draleo]

Grazie Norman. Come al solito puntuale e cortese. Ogni dubbio è stato fugato.
Ma ...dov' è il codice corretto ?
draleo

[Norman Jones]

Ciao Draleo,

Chiedo scusa per la mia svista!
In inglese si dice: More haste, less speed (più fretta, meno velocità...):

Qui segue il mio adattamento del tuo codice:


'====================
Dim myVar As Variant <<=== vedi al di sotto
Sub ListBox1_Click()
myVar = vbEmpty

Lrow = Cells(Rows.Count, "G").End(xlUp).Row

On Error GoTo ErrHandler

UserForm2.ListBox2.List = Unique_With_Pivot(Range("G12:G" & Lrow))
'creo le item della listbox2 ordinate

UserForm2.Show
Exit Sub

ErrHandler:
If Not (IsEmpty(myVar)) Then
UserForm2.ListBox2.AddItem myVar
UserForm2.Show
End If
End Sub

Function Unique_With_Pivot(rng As Excel.Range, Optional bValid As Boolean)

Dim r As Excel.Range, sPFName As String
Dim PC As PivotCache, PT As PivotTable
Set r = rng.Parent.Parent.Worksheets.Add.[a3]
sPFName = rng(1).Value
Set PC = rng.Parent.Parent.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rng.Address(, , , True))
Set PT = r.Parent.PivotTables.Add(PC, r, "tabella_pivot_x")
With PT.PivotFields(sPFName)
.Orientation = xlRowField
.Position = 1
Unique_With_Pivot = .DataRange.Value
End With
Application.DisplayAlerts = False
r.Parent.Delete
Application.DisplayAlerts = True

bValid = (IsArray(Unique_With_Pivot))
If Not bValid Then myVar = Unique_With_Pivot
End Function
'====================

Npta bene: La variabile myVar deve essere dichiarata nella parte
superiore del modulo, prima di qualsiasi altro codice.



===
Regards,
Norman

[draleo]

OK. Ora è perfetto. Grazie ancora
draleo

[r]

Il giorno venerdì 1 novembre 2013 12:35:55 UTC+1, draleo ha scritto:
> OK. Ora è perfetto. Grazie ancora
>
> draleo

oltre a quanto già suggerito e edisponendo di una versione di excel dal 2007 possiamo usare il metodo RemoveDuplicates ... per esempio così:

Function Unique_With_RemoveDuplicates(rng As Excel.Range)
Dim vRng As Excel.Range
Set vRng = rng.Parent.Parent.Worksheets.Add.[a1]
rng.Copy vRng
vRng.CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
Unique_With_RemoveDuplicates = vRng.CurrentRegion.Value
Application.DisplayAlerts = False
vRng.Parent.Delete

Application.DisplayAlerts = True
End Function

saluti
r

[draleo]

Per dare a Cesare quel che è di Cesare: Avevo erroneamente attribuito la funzione Unique_With_Pivot (di qualche anno fa) a Norman. In realtà mi accorgo ora che l'autore era r. Per quanto riguarda invece la nuova funzione di r Unique_With_RemoveDuplicates, essa rimuove solo una parte dei duplicati (ma non tutti). Inoltre NON ordina i risultati
Leonardo

[r]

Per ordinare non ci sono grossi problemi, invece dovresti essere piu preciso sul fatto che non toglie tutti i duplicati ... Puoi incollare qui due voci uguali che non sono state sfoltite?

[draleo]

Il giorno domenica 3 novembre 2013 22:00:27 UTC+1, r ha scritto:
> Per ordinare non ci sono grossi problemi, invece dovresti essere piu preciso sul fatto che non toglie tutti i duplicati ... Puoi incollare qui due voci uguali che non sono state sfoltite?

Sono tante voci: se per es c'è in elenco 40 volte la voce ECG (oppure V.Oculistica oppure V.Ortopedica di conTrollo)disposte in varie posizione nella col A del Foglio provvisorio, la funzione ne toglie 37-38, ma ne rimangono sempre 2-3 uguali. E questo non è dovuto a differenze nel modo di scrivere queste voci, perché con lo stesso elenco (e quindi con le stesse voci) la funzione Unique_with_pivot elimina TUTTI i doppioni
draleo

[buonoc...@gmail.com]

Le tabelle Pivot gestiscono Item trimmati ( cioè vengono eliminati gli spazi finali e ( da verificare ) iniziali. In altre tipi di operazioni gli spazi fanno differenza. Testa con la Funzione LUNGHEZZA se i valori che ritieni uguali in realtà siano stringhe di lunghezza diversa.
Ciao
Elio

[buonoc...@gmail.com]

Non vedo la mia risposta. Pertanto replico. Le tabelle Pivot trimmano i valori che gestiscono. Altre funzioni o metodi no. Verifica con la funzione LUNGHEZZA quante sono lunghe le stringhe apparentemente uguali.

Ciao
Elio
Il giorno lunedì 4 novembre 2013 00:39:06 UTC+1, draleo ha scritto:

[draleo]

Trovato ! Nel range che passavo alla funzione non mettevo l'intestazione della colonna. Quindi non veniva considerata la prima riga. Ora ho cambiato Header:=xlYes in Header:=xlNo
e l'eliminazione dei doppioni è corretta .Rimane il problema di come ordinare i risultati
draleo

[r]

Il giorno lunedì 4 novembre 2013 01:16:12 UTC+1, draleo ha scritto:
> Il giorno lunedì 4 novembre 2013 01:04:22 UTC+1, buonoc...@gmail.com ha scritto: > Le tabelle Pivot gestiscono Item trimmati ( cioè vengono eliminati gli spazi finali e ( da verificare ) iniziali. In altre tipi di operazioni gli spazi fanno differenza. Testa con la Funzione LUNGHEZZA se i valori che ritieni uguali in realtà siano stringhe di lunghezza diversa. > > Ciao > > Elio > > Il giorno lunedì 4 novembre 2013 00:39:06 UTC+1, draleo ha scritto: > > > Il giorno domenica 3 novembre 2013 22:00:27 UTC+1, r ha scritto: > > > > > > > Per ordinare non ci sono grossi problemi, invece dovresti essere piu preciso sul fatto che non toglie tutti i duplicati ... Puoi incollare qui due voci uguali che non sono state sfoltite? > > > > > > > > > > > > Sono tante voci: se per es c'è in elenco 40 volte la voce ECG (oppure V.Oculistica oppure V.Ortopedica di conTrollo)disposte in varie posizione nella col A del Foglio provvisorio, la funzione ne toglie 37-38, ma ne rimangono sempre 2-3 uguali. E questo non è dovuto a differenze nel modo di scrivere queste voci, perché con lo stesso elenco (e quindi con le stesse voci) la funzione Unique_with_pivot elimina TUTTI i doppioni > > > > > > draleo Trovato ! Nel range che passavo alla funzione non mettevo l'intestazione della colonna. Quindi non veniva considerata la prima riga. Ora ho cambiato Header:=xlYes in Header:=xlNo e l'eliminazione dei doppioni è corretta .Rimane il problema di come ordinare i risultati draleo

Strano che non passavi l'intestazione ... visto che la passi anche nel caso della prima funzione con pivot. Comunque non si giustificherebbe il fatto che rimangono 2-3 doppioni come invece sostenevi. Quindi i valori erano diversi. Probabile che come suggerito da Elio alcuni spazi terminali abbiano influenzato il risultato.
saluti
r

[r]

Il giorno lunedì 4 novembre 2013 01:09:50 UTC+1, buonoc...@gmail.com ha scritto:
> Non vedo la mia risposta. Pertanto replico. Le tabelle Pivot trimmano i valori che gestiscono. Altre funzioni o metodi no. Verifica con la funzione LUNGHEZZA quante sono lunghe le stringhe apparentemente uguali. Ciao Elio Il giorno lunedì 4 novembre 2013 00:39:06 UTC+1, draleo ha scritto: > Il giorno domenica 3 novembre 2013 22:00:27 UTC+1, r ha scritto: > > > Per ordinare non ci sono grossi problemi, invece dovresti essere piu preciso sul fatto che non toglie tutti i duplicati ... Puoi incollare qui due voci uguali che non sono state sfoltite? > > > > Sono tante voci: se per es c'è in elenco 40 volte la voce ECG (oppure V.Oculistica oppure V.Ortopedica di conTrollo)disposte in varie posizione nella col A del Foglio provvisorio, la funzione ne toglie 37-38, ma ne rimangono sempre 2-3 uguali. E questo non è dovuto a differenze nel modo di scrivere queste voci, perché con lo stesso elenco (e quindi con le stesse voci) la funzione Unique_with_pivot elimina TUTTI i doppioni > > draleo

Ho fatto una prova con il mio excel 2010.
Sia usando pivot che elimina duplicati le voci in elenco vengono correttamente distinte in caso presentino spazi iniziali o finali (quindi non vengono tolti) ... in entrambi i casi non sono considerate maiuscole/minuscole.

Saluti
r

[r]

Il giorno lunedì 4 novembre 2013 01:16:12 UTC+1, draleo ha scritto:

>Rimane il problema di come ordinare i risultati draleo

ho modificato in modo da ordinare il risultato, ho anche fatto in modo che passando l'intestazione essa non finisca poi nella listbox.

Function Unique_With_RemoveDuplicates(rng As Excel.Range)
Dim vRng As Excel.Range, lHeader As Long
lHeader = xlNo '<< modificare all'occorrenza

Set vRng = rng.Parent.Parent.Worksheets.Add.[a1]
rng.Copy vRng

vRng.CurrentRegion.RemoveDuplicates Columns:=1, Header:=lHeader
Set vRng = vRng.CurrentRegion
vRng.Sort vRng(1), , , , , , , lHeader
If lHeader = xlYes Then
Set vRng = vRng.Offset(1).Resize(vRng.Rows.Count - 1)
End If
Unique_With_RemoveDuplicates = vRng.Value

[draleo]

> Strano che non passavi l'intestazione ... visto che la passi anche nel caso della prima funzione con pivot. Comunque non si giustificherebbe il fatto che rimangono 2-3 doppioni come invece sostenevi. Quindi i valori erano diversi. Probabile che come suggerito da Elio alcuni spazi terminali abbiano influenzato il risultato.
>
> saluti
>
> r

Non passavo l'intestazione della colonna alla funzione, perché ,altrimenti, poi me la ritrovavo come voce nella listbox (mentre con la funzione Unique With Pivot La cosa non si verifica).Adesso continuo a non passare l'intestazione, ma sostituendo Header:=xlYes con Header:=xlNo , tutto funziona (almeno così sembra ad un primo controllo )
draleo

[r]

Il giorno lunedì 4 novembre 2013 12:12:50 UTC+1, draleo ha scritto:
> Non passavo l'intestazione della colonna alla funzione, perché ,altrimenti, poi me la ritrovavo come voce nella listbox

si mi ero accorto di questo errore ... guarda il mio precedente post con la funzione modificata e corretta.
Saluti
r

[draleo]

Ok. Ora tutto funziona bene (anche l'ordinamento dei risultati)
grazie
draleo