Codigo VBA para un Listbox con mas de 10 columnas
Estoy trabajando con un UserForm el cual contiene un listBox en el que cargo una base de datos por medio un filtro. El problema que me presenta el listBox es que no me carga mas de 10 columnas y necesito cargar 26.
Les agradezco su ayuda y asesoría para solucionar dicho error.
Anexo para el código para su revisión.
'Cambia el TextBox con cada cambio en el Combo
'
Private Sub cmbEncabezado_Change()
Me.lblFiltro = "Filtro por " & Me.cmbEncabezado.Value
End Sub
'
'Cerrar formulario
Private Sub CommandButton2_Click()
Unload Me
End Sub
'
'
'Mostrar resultado en ListBox
Private Sub CommandButton5_Click()
On Error GoTo Errores
If Me.txtFiltro1.Value = "" Then Exit Sub
Me.ListBox1.Clear
Columna = Me.cmbEncabezado.ListIndex
j = 1
Filas = Range("a1").CurrentRegion.Rows.Count
For i = 1 To Filas
If LCase(Cells(i, j).Offset(0, CInt(Columna)).Value) Like "*" & LCase(Me.txtFiltro1.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, j)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, j).Offset(0, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(i, j).Offset(0, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(i, j).Offset(0, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Cells(i, j).Offset(0, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Cells(i, j).Offset(0, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = Cells(i, j).Offset(0, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = Cells(i, j).Offset(0, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = Cells(i, j).Offset(0, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = Cells(i, j).Offset(0, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 10) = Cells(i, j).Offset(0, 10)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 11) = Cells(i, j).Offset(0, 11)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 12) = Cells(i, j).Offset(0, 12)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 13) = Cells(i, j).Offset(0, 13)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 14) = Cells(i, j).Offset(0, 14)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 15) = Cells(i, j).Offset(0, 15)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 16) = Cells(i, j).Offset(0, 16)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 17) = Cells(i, j).Offset(0, 17)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 18) = Cells(i, j).Offset(0, 18)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 19) = Cells(i, j).Offset(0, 19)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 20) = Cells(i, j).Offset(0, 20)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 21) = Cells(i, j).Offset(0, 21)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 22) = Cells(i, j).Offset(0, 22)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 23) = Cells(i, j).Offset(0, 23)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 24) = Cells(i, j).Offset(0, 24)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 25) = Cells(i, j).Offset(0, 25)
Else
End If
Next i
Exit Sub
Errores:
MsgBox "No se encuentra.", vbExclamation, "EXCELeINFO"
End Sub
'Activar la celda del registro elegido
Private Sub ListBox1_Click()
Range("a2").Activate
Cuenta = Me.ListBox1.ListCount
Set Rango = Range("A1").CurrentRegion
For i = 0 To Cuenta - 1
If Me.ListBox1.Selected(i) Then
Valor = Me.ListBox1.List(i)
Rango.Find(What:=Valor, LookAt:=xlWhole, After:=ActiveCell).Activate
End If
Next i
End Sub
'
'Dar formato al ListBox y traer los encabezados de la tabla
Private Sub UserForm_Initialize()
'
For i = 1 To 26
Me.Controls("Label" & i) = Cells(1, i).Value
Next i
'
With Me
.ListBox1.ColumnCount = 26
.ListBox1.ColumnWidths = "30 pt;55 pt;50 pt;55 pt;75 pt;65 pt;45 pt;45 pt;50 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt"
.cmbEncabezado.List = Application.Transpose(ActiveCell.CurrentRegion.Resize(1).Value)
.cmbEncabezado.ListStyle = fmListStyleOption
End With
End Sub
2 Respuestas
El echo de utilizar tablas y anexarlas al LISTBOX mediante ROWSOURCE es muy bueno, pero requiere mas consumo de recursos por lo que el proceso de ejecución se hará lento. Yo lo solucione concatenando datos. Mi LISTBOX ocupaba 32 columnas y al concatenar datos solo utilice 8, aclaro que mis datos hacienden a 78000 registros por lo que con una cantidad menor de datos el ROWSOURCE no se vera afectado.
For Registros=1 to TotalRegistros
ListBox.AddItem Dato1&Dato2&...&Dato10
ListBox.List(Registros,1)=Dato11&...&Dato20
...
Next Registros
Como ya te diste cuenta, solamente puedes cargar hasta 10 columnas con el método AddItem, esto es una limitación de VBA, pero una opción para hacer una carga de más de 10 columnas es con la propiedad RowSource.
Te anexo el código actualizado con RowSource.
Para que funcione deberás crear una hoja llamada "temporal", incluso puedes mantener oculta esta hoja.
Modifiqué el código en el control Initizlize, supongo que tienes una etiqueta para cada encabezado de la 26 columnas, con la propiedad RowSource, puedes activar la propiedad ColumnHeads, de esta forma cuando cargues los datos en el listbox ya tendrán encabezado.
Private Sub UserForm_Initialize()
'
'For i = 1 To 26
'Me.Controls("Label" & i) = Cells(1, i).Value
'Next i
'
[A1].Select
With Me
.ListBox1.ColumnHeads = True
.ListBox1.ColumnCount = 26
.ListBox1.ColumnWidths = "30 pt;55 pt;50 pt;55 pt;75 pt;65 pt;45 pt;45 pt;50 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt;60 pt"
.cmbEncabezado.List = Application.Transpose(ActiveCell.CurrentRegion.Resize(1).Value)
.cmbEncabezado.ListStyle = fmListStyleOption
End With
End SubEsta es la actualización a la carga de datos:
Private Sub CommandButton5_Click()
'Act.Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Temporal")
'
If Me.txtFiltro1.Value = "" Then Exit Sub
If cmbEncabezado = "" Then Exit Sub
'
h2.Cells.Clear
ListBox1.RowSource = ""
h1.Rows(1).Copy h2.Rows(1)
'
j = cmbEncabezado.ListIndex + 1
n = 2
'
For i = 2 To Range("a1").CurrentRegion.Rows.Count
If LCase(Cells(i, j)) Like "*" & LCase(txtFiltro1) & "*" Then
h1.Rows(i).Copy h2.Rows(n)
n = n + 1
End If
Next i
u = Range("A" & Rows.Count).End(xlUp).Row
If u = 1 Then
MsgBox "No existen registros con ese filtro", vbExclamation, "FILTRO"
Exit Sub
End If
ListBox1.RowSource = h2.Name & "!A2:Z" & u
End SubTodo el demás código que tienes en el formulario no lo modifiqué.
Prueba y me comentas.
Saludos. Dante Amor
Si es lo que necesitas.
Hola:
Primero quiero agradecerte porque el código que me planteaste funciono a la perfección, Sin duda alguna fue una excelente respuesta,
Segundo, nuevamente solicitar tus servicios ya que luego de cargar las 26 columnas en el listBox, procedo a modificar los registros de la fila seleccionada.
Para este caso utilizo un CommandButton que me vincula con otro UserForm el cual contiene 26 TextBox, la idea es que los 26 campos de fila seleccionada en el listBox pasen a los TextBox, modificar alguno si es el caso y nuevamente pegar la información en la tabla de excel
El código que te anexo a continuación funcionó a la perfección en otro caso en donde solo manejaba 8 columnas,
Me gustaría que me ayudaras revisando los códigos que te anexo y me regales los ajustes correspondientes.
'Traer el UserForm con los 26 TextBox para modificar los datos
Private Sub CommandButton6_Click()
If Me.ListBox1.ListIndex < 0 Then
MsgBox "No se ha elegido ningún registro", vbExclamation, "Inspecciones"
Else
UserForm2.Show
End If
End Sub
'Trae los datos de la fila seleccionada en el ListBox
Private Sub UserForm_Click()
For i = 1 To 8
Me.Controls("TextBox" & i).Value = ActiveCell.Offset(0, i - 1).Value
Next i
End Sub
'Pega los datos de los TextBox en la tabla de excel
Private Sub CommandButton1_Click()
For i = 1 To 8
ActiveCell.Offset(0, i - 1).Value = Me.Controls("TextBox" & i).Value
ActiveCell.Offset(0, 2).Value = Format(TextBox3, "mm/dd/yyyy")
Next i
Unload Me
End Sub
Puedes valorar esta respuesta y crear una nueva por cada petición.
Hola amigo podrías mandarme el código completo y donde agregar el código que enviaste - Joaquin Rocha