No puedo encontrar una solución al siguiente código de VB Aplication
Tengo un error en el siguiente código a la hora de ejecutarlo no valida la ultima columna "Me.ListBox1.List(Me.ListBox1.ListCount - 1, 11) = Cells(i, j).Offset(0, 11)" no entra al next i y se pasa directamente al mensaje de error , solo me da el primer registro que encuentra en la tabla y no todos que tengan coincidencias en el filtro de columna de nombres si me pudieran ayudar en donde esta el error les agradecería mucho
abajo coloco el código completo
Private Sub CommandButton6_Click()
On Error GoTo Errores
If Me.txtFiltro1.Value = "" Then Exit Sub
Me.ListBox1.Clear
j = 1
Filas = Range("a1").CurrentRegion.Rows.Count
For i = 2 To Filas
If LCase(Cells(i, j).Offset(0, 3).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)
Else
End If
Next i
Exit Sub
Errores:
MsgBox "No se encuentra.", vbExclamation, "Aviso"
End Sub
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
Private Sub UserForm_Initialize()
For i = 1 To 11
Me.Controls("Label" & i) = Cells(1, i).Value
Next i
With ListBox1
.ColumnCount = 11
.ColumnWidths = "100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt;100 pt"
End With
End Sub
2 Respuestas
La propiedad .List no admite mas de 10 columnas, para eso vas a tener que usar un Array de dos dimensiones y se te va a complicar un poco.
Luego cargas la propiedad .List con el array, todo de una.
Pero si el rango que vas a cargar es dinámico tendrás que ir agrandando el array con ReDim Preserve, pero solo puedes agrandar la ultima dimensión, osea la columna. Así que, si vas a pasar los datos a la hoja antes que al listbox, puedes usar la función Transpose para invertirlo, si no, en lugar de usar .List, usarías la propiedad .Column. Pero es todo un enredo eso y tiene ciertas limitaciones.
Si tuviera mas tiempo te haría el código, de todas formas buscare en algún Excel, creo que en alguno debo tener un código para eso.
Espero que almenos agarres la idea de por que te da el error y creativamente se te ocurra una solución.
Andy M.
Veo que usas un solo criterio, es más sencillo así. Encontré este, lo usaba para filtrar una hoja buscando por el nombre del País que estaba en la columna B.
Adáptalo para que te sirva a ti:
Sub FilterCountry()
Dim dataSht As Worksheet: Set dataSht = Sheets("Sheet1")
Dim uF As Integer, rowCnt As Long, colCnt As Integer
Dim rCell As Range, rRng As Range
Dim paisC As String
Dim lstArr() As Variant
uF = dataSht.Range("A" & Rows.Count).End(xlUp).Row
Set rRng = dataSht.Range("A2:A" & uF)
If Trim(UserForm1.TextBox1.Value) = "" Then
UserForm1.ListBox1.RowSource = "='" & dataSht.Name & "'!A2:N" & uF
Exit Sub
End If
AutoFilterMode = False
UserForm1.ListBox1 = Clear
UserForm1.ListBox1.RowSource = Clear
rowCnt = 0
For Each rCell In rRng.Cells
paisC = rCell.Offset(0, 1).Value
If UCase(paisC) Like UCase(UserForm1.TextBox1.Value) & "*" Then
ReDim Preserve lstArr(14, 0 To rowCnt)
lstArr(0, rowCnt) = rCell.Value
For colCnt = 0 To 14
lstArr(colCnt, rowCnt) = rCell.Offset(0, colCnt).Value
Next colCnt
rowCnt = rowCnt + 1
End If
Next rCell
On Error GoTo ErrHandler
UserForm1.ListBox1.Column = lstArr
Exit Sub
ErrHandler:
UserForm1.ListBox1 = Clear
UserForm1.ListBox1.RowSource = Clear
End SubEs un poco viejo y tal vez se pueda mejorar, pero lo probé y funciona.
.
Creo que es porque tienes 11 columnas y addItem sólo admite 10 columnas