Tengo un Listbox con 20 columnas pero sólo me muestra 10

Tengo un listbox con 20 columnas pero sólo me muestra 10. El código es el siguiente:

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub Label2_Click()

End Sub

Private Sub Label3_Click()

End Sub

Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
Set a = Sheets("Hoja1")
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
a.Cells(filaedit, "C") = ListBox1.List(fila, 2)
a.Cells(filaedit, "D") = ListBox1.List(fila, 3)
a.Cells(filaedit, "E") = ListBox1.List(fila, 4)
a.Cells(filaedit, "F") = ListBox1.List(fila, 5)
a.Cells(filaedit, "G") = ListBox1.List(fila, 6)
a.Cells(filaedit, "H") = ListBox1.List(fila, 7)
a.Cells(filaedit, "I") = ListBox1.List(fila, 8)
a.Cells(filaedit, "J") = ListBox1.List(fila, 9)
a.Cells(filaedit, "K") = ListBox1.List(fila, 10)
a.Cells(filaedit, "L") = ListBox1.List(fila, 11)
a.Cells(filaedit, "M") = ListBox1.List(fila, 12)
a.Cells(filaedit, "N") = ListBox1.List(fila, 13)
a.Cells(filaedit, "O") = ListBox1.List(fila, 14)
a.Cells(filaedit, "P") = ListBox1.List(fila, 15)
a.Cells(filaedit, "Q") = ListBox1.List(fila, 16)
a.Cells(filaedit, "R") = ListBox1.List(fila, 17)
a.Cells(filaedit, "S") = ListBox1.List(fila, 18)
a.Cells(filaedit, "T") = ListBox1.List(fila, 19)
End If
End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Tercero_A")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
'Me.ListBox1.List() = b.Range("A8:T" & uf).Value
Me.ListBox1.RowSource = "Tercero_A!A8:T" & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 2).Value
If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = b.Cells(i, 10)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 10) = b.Cells(i, 11)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 11) = b.Cells(i, 12)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 12) = b.Cells(i, 13)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 13) = b.Cells(i, 14)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 14) = b.Cells(i, 15)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 15) = b.Cells(i, 16)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 16) = b.Cells(i, 17)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 17) = b.Cells(i, 18)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 18) = b.Cells(i, 19)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 19) = b.Cells(i, 20)
End If
Next i
Me.ListBox1.ColumnWidths = "25pt; 150pt; 0pt; 0pt; 0pt; 0pt; 50pt; 50pt; 50pt; 50pt; 0pt; 50pt; 50pt; 50pt; 0pt; 0pt; 0pt; 0pt; 0pt; 50pt"
End Sub

Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets("Tercero_A")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = "" Then
'Me.ListBox1.List() = b.Range("A8:T" & uf).Value
Me.ListBox1.RowSource = "Tercero_A!A8:T" & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 1).Value
If UCase(strg) Like UCase(TextBox2.Value) & "*" Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = b.Cells(i, 9)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = b.Cells(i, 10)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 10) = b.Cells(i, 11)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 11) = b.Cells(i, 12)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 12) = b.Cells(i, 13)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 13) = b.Cells(i, 14)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 14) = b.Cells(i, 15)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 15) = b.Cells(i, 16)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 16) = b.Cells(i, 17)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 17) = b.Cells(i, 18)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 18) = b.Cells(i, 19)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 19) = b.Cells(i, 20)
End If
Next i
Me.ListBox1.ColumnWidths = "25pt; 150pt; 0pt; 0pt; 0pt; 0pt; 50pt; 50pt; 50pt; 50pt; 0pt; 50pt; 50pt; 50pt; 0pt; 0pt; 0pt; 0pt; 0pt; 50pt"
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Tercero_A")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 20
.ColumnWidths = "25pt; 150pt; 0pt; 0pt; 0pt; 0pt; 50pt; 50pt; 50pt; 50pt; 0pt; 50pt; 50pt; 50pt; 0pt; 0pt; 0pt; 0pt; 0pt; 50pt"
.RowSource = "Tercero_A!A8:" & wc & uf
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

PREGUNTA: ¿Cuál será el error?

Anticipadamente.

Respuesta
2

Revisa el siguiente enlace:

Codigo VBA para un Listbox con mas de 10 columnas

En VBA con el método Adiitem solamente puedes cargar 10 columnas.

No te envía error VBA porque tienes la sentencia On Error Resume Next; pero si quitas la sentencia y ejecutas el userform para cargar los datos verás que se detiene cuando quieres agregar la columna 11.

sal u dos

El problema es que no sé nada de programación :-(

¿Podrían ayudarme a generar el código? No existe ningún problema cuando carga la base datos, carga perfectamente las 20 columnas, el problema se presenta cuando al filtrar sólo me aparecen hasta 10 columnas cuando necesito que también en el filtrado carguen las 20 columnas.

Disculpen las molestias. Anticipadamente, gracias.

No es ninguna molestia.

Tu código tiene algunos detalles.

- El rowsource lo cargas desde la fila 8, pero los For empiezan en la fila 2.

Voy a suponer que tus datos empiezan en la fila 2 y que el encabezado está en la fila 1.

- Solamente muestra 10 columnas, primero, porque con Additem solamente puedes cargar 10 columnas; y segundo, tienes en columnwidth 10 columnas en 0pt

Realiza las siguientes instrucciones.

1. Crea una hoja llamada "temp"

2. Cambia todo tu código por el siguiente:

Dim h1, h2, h3
'
Private Sub TextBox1_Change()
    Call Filtrar("B", TextBox1.Value)
End Sub
Private Sub TextBox2_Change()
    Call Filtrar("A", TextBox2.Value)
End Sub
'
Sub Filtrar(col, dato)
'Por.Dante Amor
    h2.Cells.Clear
    h1.Rows(1).Copy h2.Rows(1)
    f = 2
    j = 2
    ListBox1.RowSource = ""
    uf = h1.Range("A" & Rows.Count).End(xlUp).Row
    h1.AutoFilterMode = False
    For i = f To uf
        If UCase(h1.Cells(i, col).Value) Like UCase(dato) & "*" Then
            h1.Rows(i).Copy h2.Rows(j)
            h2.Cells(j, "U") = i
            j = j + 1
        End If
    Next i
    uf = h2.Range("A" & Rows.Count).End(xlUp).Row
    If uf > 1 Then ListBox1.RowSource = h2.Name & "!A2:U" & uf
End Sub
'
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Act.Por.Dante Amor
    If KeyAscii <> 13 Then Exit Sub
    '
    u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
    fila = ListBox1.List(ListBox1.ListIndex, 20)
    h1.Rows(fila).Copy h3.Rows(u)
    MsgBox "Registro copiado de " & h1.Name & " a " & h3.Name, vbInformation
End Sub
'
Private Sub UserForm_Initialize()
'Act.Por.Dante Amor
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set h1 = Sheets("Tercero_A")
    Set h2 = Sheets("Temp")
    Set h3 = Sheets("Hoja1")
    uf = h1.Range("A" & Rows.Count).End(xlUp).Row
    With Me.ListBox1
        .ColumnCount = 20
        .ColumnHeads = True
    End With
    TextBox1_Change
End Sub
'
Private Sub CommandButton1_Click()
    Unload Me
End Sub

3. En mi macro f = 2 , cambia el 2 por el número de fila donde empiezan tus datos.

4. Revisa que al principio de todo el código queden las declaraciones de variables:

Dim h1, h2

Sal u dos

Muchas gracias Dante, he probado la macro y me muestra las 20 columnas que anteriormente no lo hacia, además de mencionarte que los encabezados ahora hasta me los muestra, cosa que anteriormente uno los tenía que escribir de manera manual. Te agradezco infinitamente todo tu apoyo y dedicación de tiempo a mis dudas y necesidades. Recibe un abrazo. ¡Saludos!

1 respuesta más de otro experto

Respuesta
1

A lo dicho puedes cargar más de 10 columnas si usas el método rowsource, te paso un ejemplo

https://youtu.be/4YyMHEZ1h_8

https://youtu.be/VJGRNxZtpBg

Ya revisé el video maestro y entiendo que el Rowsoucer carga las 20 columnas en la base de datos, mi problema se presenta cuando al hacer el filtrado sólo me aparece la información de 20 columnas y el resto de la información desaparece. No se nada de programación, de hecho, el código lo obtuve revisando sus tutoriales maestro. ¿Sería mucho pedir que me generara el código para posteriormente pegarlo en mi archivo? Anticipadamente, gracias.

Sube tu archivo desde http://programarexcel.com o mail que esta ahí.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas