es.davy.ai

Preguntas y respuestas de programación confiables

¿Tienes una pregunta?

Si tienes alguna pregunta, puedes hacerla a continuación o ingresar lo que estás buscando.

Cómo filtrar datos en combo Box vba

11 Jun, 2023 Programación

Me quedé atrapado en este problema en el que tengo que filtrar datos en un cuadro combinado. La lista solo debería tener registros únicos.
Aquí está el código para poblar registros en el cuadro combinado:

Private Sub UserForm_Activate()
Dim myrng As Range
Dim cl As Range
Dim sh As Worksheet
Set sh = Worksheets(“Product_Master”)

    Set myrng = sh.Range("C2:C100000")
    With Me.comBox_Purchase_Product
        .Clear
        For Each cl In myrng.Cells
            If cl.Value <> "" Then
                .AddItem cl.Value
            End If
        Next cl
    End With
End sub

Aquí están los productos que estoy obteniendo … ahora solo quiero registros únicos y eliminar todos los duplicados.

Gracias de antemano.

Tags:  , , , ,

Answer

  1. Avatar for davy.ai
    davy.ai

    Para filtrar los datos en la caja combinada y mostrar solo registros únicos, puede modificar el código de la siguiente manera:

    “`Private Sub UserForm_Activate()
    Dim myrng As Range
    Dim cl As Range
    Dim sh As Worksheet
    Dim uniqueList As Variant
    Dim i As Long
    Dim j As Long

    Set sh = Worksheets("Product_Master")
Set myrng = sh.Range("C2:C100000")

' Use un objeto de diccionario para obtener valores únicos
Set uniqueList = CreateObject("Scripting.Dictionary")
For Each cl In myrng.Cells
    If cl.Value <> "" And Not uniqueList.exists(cl.Value) Then
        uniqueList.Add cl.Value, cl.Value
    End If
Next cl

' Copiar valores únicos en un array
ReDim arrList(uniqueList.Count - 1)
i = 0
For Each item In uniqueList.keys
    arrList(i) = item
    i = i + 1
Next item

' Ordenar el array
For i = LBound(arrList) To UBound(arrList) - 1
    For j = i + 1 To UBound(arrList)
        If arrList(i) > arrList(j) Then
            SwapValues arrList(i), arrList(j)
        End If
    Next j
Next i

' Agregar elementos a la caja combinada
With Me.comBox_Purchase_Product
    .Clear
    For i = LBound(arrList) To UBound(arrList)
        .AddItem arrList(i)
    Next i
End With

    End Sub

    Sub SwapValues(ByRef a As Variant, ByRef b As Variant)
    Dim temp As Variant
    temp = a
    a = b
    b = temp
    End Sub
    “`

    Este código usa un objeto de diccionario para almacenar los valores únicos del rango C2:C100000. Luego copia los valores únicos en un array, los ordena y agrega los elementos a la caja combinada. El subrutina SwapValues se utiliza para intercambiar dos valores en el array durante el proceso de ordenamiento.

Comments are closed.