Llenar un cuadro de lista con valores únicos de una hoja de trabajo con VBA en Microsoft Excel
En este artículo, crearemos un cuadro de lista en forma de usuario y lo cargaremos con valores después de eliminar los valores duplicados.
Los datos brutos que insertaremos en el cuadro de lista constan de nombres. Estos datos brutos contienen duplicidad en nombres definidos.
En este ejemplo, hemos creado un formulario de usuario que consta de List Box.
Este cuadro de lista mostrará nombres únicos de los datos de muestra. Para activar el formulario de usuario, haga clic en el botón enviar.
Este formulario de usuario devolverá el nombre seleccionado por el usuario como salida en un cuadro de mensaje.
Explicación lógica
Antes de agregar nombres en el cuadro de lista, hemos utilizado el objeto de colección para eliminar nombres duplicados.
Hemos realizado los siguientes pasos para eliminar entradas duplicadas: -. Se agregaron nombres del rango definido en la hoja de Excel al objeto de colección. En el objeto de colección, no podemos insertar valores duplicados. Entonces, el objeto Collection arroja un error al encontrar valores duplicados. Para manejar los errores, hemos utilizado la declaración de error «En caso de error, reanudar a continuación».
-
Después de preparar la colección, agregue todos los elementos de la colección a la matriz.
-
Luego, inserte todos los elementos de la matriz en el Cuadro de lista.
Siga a continuación el código
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
'Looping through all the values present in the list box
'Assigning the selected value to variable var1
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
var1 = ListBox1.List(i)
Exit For
End If
Next
'Unload the userform.
Unload Me
'Displaying the selected value
MsgBox "You have selected following name in the List Box : " & var1
End Sub
Private Sub UserForm_Initialize()
Dim MyUniqueList As Variant, i As Long
'Calling UniqueItemList function
'Assigning the range as input parameter
MyUniqueList = UniqueItemList(Range("A12:A100"), True)
With Me.ListBox1
'Clearing the List Box content
.Clear
'Adding values in the List Box
For i = 1 To UBound(MyUniqueList)
.AddItem MyUniqueList(i)
Next i
'Selecting the first item
.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
'Declaring a dynamic array
Dim uList() As Variant
'Declaring this function as volatile
'Means function will be recalculated whenever calculation occurs in any cell
Application.Volatile
On Error Resume Next
'Adding items to collection
'Only unique item will be inserted
'Inserting duplicate item will through an error
For Each cl In InputRange
If cl.Value <> "" Then
'Adding values in collection
cUnique.Add cl.Value, CStr(cl.Value)
End If
Next cl
'Initializing value return by the function
UniqueItemList = ""
If cUnique.Count > 0 Then
'Resizing the array size
ReDim uList(1 To cUnique.Count)
'Inserting values from collection to array
For i = 1 To cUnique.Count
uList(i) = cUnique(i)
Next i
UniqueItemList = uList
'Checking the value of HorizontalList
'If value is true then transposing value of UniqueItemList
If Not HorizontalList Then
UniqueItemList = _
Application.WorksheetFunction.Transpose(UniqueItemList)
End If
End If
On Error GoTo 0
End Function
Si te gustó este blog, compártelo con tus amigos en Facebook y Facebook.
Nos encantaría saber de usted, háganos saber cómo podemos mejorar nuestro trabajo y hacerlo mejor para usted. Escríbanos a [email protected]