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
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
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
----- --
No hay comentarios.:
Publicar un comentario