Completați o casetă listă cu valori unice dintr-o foaie de lucru utilizând VBA în Microsoft Excel

Anonim

În acest articol, vom crea o casetă listă în forma de utilizator și o vom încărca cu valori după eliminarea valorilor duplicate.

Datele brute pe care le vom insera în caseta de listă sunt alcătuite din nume. Aceste date brute conțin duplicități în nume definite.

În acest exemplu, am creat un formular de utilizator care constă din List Box. Această casetă listă va afișa nume unice din datele eșantion. Pentru a activa formularul de utilizator, faceți clic pe butonul de trimitere.

Această formă de utilizator va returna numele selectat de utilizator ca ieșire într-o casetă de mesaje.

Explicație logică

Înainte de a adăuga nume în caseta de listă, am folosit obiectul de colecție pentru a elimina numele duplicat.

Am efectuat următorii pași pentru a elimina intrările duplicate: -

  1. Numele adăugate din intervalul definit în foaia Excel la obiectul de colecție. În obiectul de colecție, nu putem insera valori duplicate. Deci, obiectul Colecție aruncă erori la întâlnirea valorilor duplicate. Pentru a gestiona erorile, am folosit declarația de eroare „On Error Resume Next”.

  2. După pregătirea colecției, adăugați toate elementele din colecție în matrice.

  3. Apoi, introduceți toate elementele matricei în caseta de listă.

Vă rugăm să urmați codul de mai jos

 Option Explicit Sub running () UserForm1.Show End Sub 'Add below code in userform Option Explicit Private Sub CommandButton1_Click () Dim var1 As String Dim i As Integer' Buclarea prin toate valorile prezente în caseta de listă 'Atribuirea valorii selectate variabilei var1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected (i) Then var1 = ListBox1.List (i) Exit For End If Next 'Descărcați formularul de utilizator. Descărcați-mă 'Afișarea valorii selectate MsgBox "Ați selectat următorul nume în caseta Listă:" & var1 End Sub Private Sub UserForm_Initialize () Dim MyUniqueList Ca Variant, i As Long' Apelarea funcției UniqueItemList 'Atribuirea intervalului ca parametru de intrare MyUniqueList = UniqueItemList (Range ("A12: A100"), True) With Me.ListBox1 'Ștergerea conținutului casetei de listă. Ștergeți' Adăugarea de valori în caseta de listă Pentru i = 1 la UBound (MyUniqueList). Adăugați element MyUniqueList (i) Următorul i ' Selectarea primului element .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 'Declararea unei matrice dinamice Dim uList () As Varianta „Declararea acestei funcții ca fiind volatilă” Funcția înseamnă va fi recalculată ori de câte ori are loc calculul în orice celulă Aplicație. cl In InputRange If cl.Value "" Then 'Adăugarea valorilor în colecția cUnique.Add cl.Value, CStr (cl.Value) End If Next cl' Inițializarea valorii returnate de funcția UniqueItemList = "" If cUnique.Count> 0 Then 'Redimensionarea dimensiunii matricei ReDim uList (1 To cUnique.Count)' Introducerea valorilor din colecție în matrice Pentru i = 1 To cUnique.Count uList (i) = cUnique (i) Următorul i UniqueItemList = uList 'Verificarea valorii HorizontalList' Dacă valoarea este adevărată, atunci transpune valoarea UniqueItemList Dacă nu este HorizontalList, atunci UniqueItemList = _ Application.WorksheetFunction.Transpose (UniqueItemList) End If End If On Error GoTo 0 End Function 

Dacă ți-a plăcut acest blog, distribuie-l prietenilor tăi de pe Facebook. De asemenea, ne puteți urmări pe Twitter și Facebook.

Ne-ar plăcea să aflăm de la dvs., să ne anunțați cum putem îmbunătăți munca noastră și o putem îmbunătăți. Scrieți-ne pe site-ul de e-mail