Filtrar los datos del combobox mientras escribes y desplegar las coincidencias:
Código:
__________
Option Explicit
Dim a As Variant, b As Variant
Private Sub ComboBox1_Change() Dim precio As Double With ComboBox1 .List = Filter(Application.Transpose(a), .Text, True, vbTextCompare) .DropDown TextBox1.Value = "" If .ListIndex > -1 Then precio = Sheets("Hoja1").Range("A:A").Find(.Value, , xlValues, xlWhole).Offset(, 1) TextBox1.Value = Format(precio, "$ #,###.##") End If End With End Sub
Private Sub UserForm_Activate() a = Sheets("Hoja1").Range("A2", Sheets("Hoja1").Range("A" & Rows.Count).End(3)).Value ComboBox1.List = a End Sub
Diferentes maneras de cargar datos en un combobox que se encuentra en un userform.
Cargar utilizando la propiedad RowSource, la propiedad List y el método AddItem
Carga de datos con filtro, carga de datos ordenados y desplegar las coincidencias mientras se van ingresando letras en el combobox.
Código fuente. UserForm1:
----- --
Option Explicit Private Sub UserForm_Activate() Dim sh As Worksheet Dim i As Long, uf As Long, j As Long Dim a As Variant, b As Variant Dim c As Range Dim dic As Object
Set sh = Sheets("Ej 1") 'última fila uf = sh.Range("A" & Rows.Count).End(3).Row 'carga con RowSource ComboBox2.RowSource = "'" & sh.Name & "'!A2:A" & uf '' 'carga con RowSource pero con rango nombrado ComboBox3.RowSource = "nombres_1" ' 'carga con el método AddItem For i = 2 To uf ComboBox4.AddItem sh.Range("A" & i).Value Next ' 'carga con la propiedad List ComboBox5.List = sh.Range("A2:A" & uf).Value ' 'carga con la propiedad List pero utilizando una matriz a = sh.Range("A2:A" & uf).Value ComboBox6.List = a ' 'carga con AddItem pero filtrando For Each c In sh.Range("A2:A" & uf) If InStr(1, c.Value, "o", vbTextCompare) Then ComboBox7.AddItem c.Value End If Next ' 'carga con List pero filtrando ReDim b(1 To UBound(a, 1), 1 To 1) For i = 1 To UBound(a, 1) If LCase(a(i, 1)) Like "a*" Then j = j + 1 b(j, 1) = a(i, 1) End If Next ComboBox8.List = b ' 'carga con List únicos Set dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(a, 1) dic(a(i, 1)) = Empty Next ComboBox10.List = dic.keys '' 'carga con AddItem únicos y ordenandos For i = 2 To uf Call agregar(ComboBox9, sh.Range("A" & i).Value) Next End Sub Sub agregar(combo As ComboBox, dato As String) Dim n As Long For n = 0 To combo.ListCount - 1 Select Case StrComp(combo.List(n), dato, vbTextCompare) Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega Case 1: combo.AddItem dato, n: Exit Sub 'Es menor, lo agrega antes del comparado End Select Next combo.AddItem dato 'Es mayor lo agrega al final End Sub
----- --
Código fuente. UserForm2:
----- --
Option Explicit Dim a() As Variant Dim cargando As Boolean ' Private Sub ComboBox1_Change() Dim dato As String Dim i As Long, j As Long Dim b As Variant
If cargando = True Then Exit Sub cargando = True ReDim b(0 To UBound(a, 1), 1 To 1)
With ComboBox1 dato = .Value .Clear For i = 0 To UBound(a, 1) If LCase(a(i, 0)) Like "*" & LCase(dato) & "*" Then b(j, 1) = a(i, 0) j = j + 1 End If Next .List = b .Value = dato .DropDown End With
cargando = False End Sub Private Sub UserForm_Activate() Dim sh As Worksheet Dim i As Long
Set sh = Sheets("Ej 1") 'hoja de nombres
'carga con AddItem únicos y ordenandos For i = 2 To sh.Range("A" & Rows.Count).End(3).Row Call agregar(ComboBox1, sh.Range("A" & i).Value) Next a = ComboBox1.List ComboBox1.MatchEntry = fmMatchEntryNone End Sub Sub agregar(combo As ComboBox, dato As String) Dim n As Long For n = 0 To combo.ListCount - 1 Select Case StrComp(combo.List(n), dato, vbTextCompare) Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega Case 1: combo.AddItem dato, n: Exit Sub 'Es menor, lo agrega antes del comparado End Select Next combo.AddItem dato 'Es mayor lo agrega al final End Sub