Cargar Combobox

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

----- --





No hay comentarios.:

Publicar un comentario