Riempi una casella di riepilogo con valori univoci da un foglio di lavoro utilizzando VBA in Microsoft Excel

Anonim

In questo articolo, creeremo una casella di riepilogo nel form utente e la caricheremo con i valori dopo aver rimosso i valori duplicati.

I dati grezzi che inseriremo nella List Box, sono costituiti da nomi. Questi dati grezzi contengono duplicità nei nomi definiti.

In questo esempio, abbiamo creato un form utente che consiste in List Box. Questa casella di riepilogo visualizzerà nomi univoci dai dati di esempio. Per attivare il modulo utente, fare clic sul pulsante di invio.

Questo modulo utente restituirà il nome selezionato dall'utente come output in una finestra di messaggio.

Spiegazione logica

Prima di aggiungere nomi nella casella di riepilogo, abbiamo utilizzato l'oggetto raccolta per rimuovere i nomi duplicati.

Abbiamo eseguito i seguenti passaggi per rimuovere le voci duplicate: -

  1. Aggiunti i nomi dall'intervallo definito nel foglio Excel all'oggetto della raccolta. Nell'oggetto collezione, non possiamo inserire valori duplicati. Quindi, l'oggetto Collection genera un errore quando incontra valori duplicati. Per gestire gli errori, abbiamo utilizzato l'istruzione di errore "On Error Resume Next".

  2. Dopo aver preparato la raccolta, aggiungi tutti gli elementi dalla raccolta all'array.

  3. Quindi, inserisci tutti gli elementi dell'array nella casella di riepilogo.

Si prega di seguire sotto per il codice

 Option Explicit Sub running() UserForm1.Show End Sub 'Aggiungi sotto il codice in userform Option Explicit Private Sub CommandButton1_Click() Dim var1 As String Dim i As Integer 'Esplora tutti i valori presenti nella casella di riepilogo 'Assegna il valore selezionato alla variabile var1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then var1 = ListBox1.List(i) Exit For End If Next 'Scarica il form utente. Unload Me 'Visualizzazione del valore selezionato MsgBox "Hai selezionato il seguente nome nella casella di riepilogo: " & var1 End Sub Private Sub UserForm_Initialize() Dim MyUniqueList As Variant, i As Long 'Richiamo della funzione UniqueItemList 'Assegnazione dell'intervallo come parametro di input MyUniqueList = UniqueItemList(Range("A12:A100"), True) With Me.ListBox1 'Cancellazione del contenuto della casella di riepilogo .Clear 'Aggiunta di valori nella casella di riepilogo per i = 1 a UBound(MyUniqueList) .AddItem MyUniqueList(i) Next i' Selezione del primo elemento .ListIndex = 0 End With End Sub Private Function UniqueItemList(InputRange As Range, _ HorizontalList As Boolean) As Variant Dim cl As Range, cUnique As New Collection, i As Long 'Dichiarazione di un array dinamico Dim uList() As Variante 'Dichiarare questa funzione come volatile 'La funzione significa che verrà ricalcolata ogni volta che si verifica un calcolo in qualsiasi cella Applicazione.Volatile In caso di errore Riprendi Avanti 'Aggiunta elementi alla collezione 'Verrà inserito solo un elemento unico 'Inserendo un elemento duplicato verrà generato un errore per ogni cl In InputRange If cl.Value "" Then 'Aggiunta di valori nella raccolta cUnique.Add cl.Value, CStr(cl.Value) End If Next cl 'Inizializzazione del valore restituito dalla funzione UniqueItemList = "" If cUnique.Count > 0 Then 'Ridimensionamento della dimensione dell'array ReDim uList(1 in cUnique.Count) 'Inserimento valori dalla raccolta all'array For i = 1 in cUnique.Count uList(i) = cUnique(i) Next i UniqueItemList = uList 'Controllo del valore di HorizontalList ' Se value è vero, traspone il valore di UniqueItemList If Not HorizontalList Then UniqueItemList = _ Application.WorksheetFunction.Transpose(UniqueItemList) End If End If On Error GoTo 0 End Function 

Se ti è piaciuto questo blog, condividilo con i tuoi amici su Facebook. Inoltre, puoi seguirci su Twitter e Facebook.

Ci piacerebbe avere tue notizie, facci sapere come possiamo migliorare il nostro lavoro e renderlo migliore per te. Scrivici al sito di posta elettronica