Pasar datos de un text box a un listbox desde una hoja
Comunidad e tratado de conseguir que me carguen los datos de una hoja a un listbox y realizando una búsqueda filtrada desde un textbox he seguido forso e copiado códigos y siempre me genera error y no me da el resultado esperado quedando muy agradecido por su ayuda
Utiliza el siguiente código. Cada que empiezas a capturar letras en el textbox1, en automático hace el filtrado en el listbox1.
Revisa las indicaciones en el código para que lo adaptes a tu userform:
Option Explicit
'
Dim a As Variant 'Al inicio del código
'
Private Sub TextBox1_Change()
Call FilterData
End Sub
'
Sub FilterData()
Dim txt1 As String, txt2 As String, txt3 As String
Dim b As Variant
Dim i As Long, j As Long, k As Long
'
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
ListBox1.Clear
For i = 1 To UBound(a, 1)
If TextBox1.Value = "" Then txt1 = a(i, 1) Else txt1 = TextBox1.Value
If LCase(a(i, 1)) Like "*" & LCase(txt1) & "*" Then
j = j + 1
For k = 1 To UBound(a, 2)
b(j, k) = a(i, k)
Next
End If
Next i
If j > 0 Then ListBox1.List = b
End Sub
'
Private Sub userform_initialize()
'Ajusta columna "K" para la última columna con datos
'Ajusta celda "A2" con la celda de inicio de datos
'Ajusta Hoja1 con el nombre de tu hoja
'El filtro funciona buscando los datos en la columna "A"
a = Sheets("Hoja1").Range("A2:K" & Sheets("Hoja1").Range("A" & Rows.Count).End(3)).Value
ListBox1.ColumnCount = UBound(a, 2)
End Sub---
. Si es lo que necesitas, no olvides valorar...
Buen día muchas gracias por tu respuesta no me ha querido cargar los datos en listbox lo intente con tu código sale que tengo que declarar variable, la declaro después me sale error de matriz es decir me ha quedado difícil y por ultimo error 9... al
Realizar esta actividad lo he hecho con additem y con el rowsource y tampoco no se donde este mi falla que me tiene despelucado,, gracias
Tienes que copiar el código completo.
La variable 'a' se declara al inicio de todo el código.
No debes declarar la variable 'a' como lo estás haciendo.
Revisa que tu hoja de datos se llame "Hoja4".
Revisa nuevamente el código y vuelve a probar.
lo realizo de acuerdo a tus indicaciones y el error persiste envió imagen del cuadro de lista para ver si el error es de colocar "Hoja4" o "Hoja11" mil gracias experto
Al inicio de todo el código es hasta arriba. Revisa nuevamente mi código.
La variable 'a' está en las declaraciones globales, está fuera de cualquier evento.
Está arriba del evento Textbox1_Change
---
Te comparto mi libro de pruebas para que veas cómo está el código.
https://docs.google.com/spreadsheets/d/15ZXVL4trv0aEmJeSOGnGbUbuIFFTqrxV/edit?usp=sharing&ouid=103060997651612915482&rtpof=true&sd=true
de antemano agradezco inmensamente tu apoyo reiterando el agradecimiento por tu loable gestión de enseñar metodologías de programación.... en base a la plantilla que envía me sigue generando errores ahora me sale el descrito en la imagen lo cual me sale en mi formulario igual
Veo en tu imagen que has modificado mi código. Si pudieras abrir mi archivo y ejecutar mi formulario, verás que no tiene errores. Pero no modifiques en nada el código.
Ya que veas cómo es el funcionamiento, entonces le haces las adecuaciones que quieras.
Tampoco modifiques las propiedades del Listbox.
<p><img src="http://tedata.blob.core.windows.net/uploads/md/285474a3a5dd4e389c41438406c4765e.png" contenteditable="false" unselectable="on" width="600" height="269" data-fullurl="http://tedata.blob.core.windows.net/uploads/lg/285474a3a5dd4e389c41438406c4765e.png"></p>Public campo
Public n
'DE A CUERDO A LA IMAGEN BASICAMENTE LO QUE SE NESECITA ES QUE CARGUE EL NOMBRE DESDE LA HOJA
DIGITANDO DESDE EL TEXTBOX TENGO ESTE CODIGO COMENTADO Y LA VERDAD NO ENCUENTRO EL ERROR
LA CUAL ME AYUDARIA PARA MI PROCESO DE APRENDIZAJE DE VER DONDE NO ME DEJA CARGAR LOS NOMBRES CUANDO SE DIGITAN AL LISTBOX
GRACIAS .............
Private Sub TextBox1_Change()
'On Error Resume Next
'If TextBox1 = "" Then Exit Sub
' campo = "*" & TextBox1 & "*"
' n = 1
' filtro2 "Hoja3", 4, 3
'Dim fila, i As Long
'fila = Hoja3.Range("A" & Rows.Count).End(xlUp).Row
'listcargaproductos = Clear
'For i = 2 To fila
' If UCase(Hoja3.Cells(i, 3)) Like "*" & UCase(txtproductos) & "*" Then
' With listcargaproductos
' .AddItem
' .List(.ListCount - 1, 0) = Hoja3.Cells(i, 1)
' .List(.ListCount - 1, 1) = Hoja3.Cells(i, 2)
' .List(.ListCount - 1, 3) = Hoja3.Cells(i, 3)
' .List(.ListCount - 1, 4) = Hoja3.Cells(i, 4)
' .List(.ListCount - 1, 5) = Hoja3.Cells(i, 4)
' .List(.ListCount - 1, 6) = Hoja3.Cells(i, 5)
'
' End With
' End If
' Dim fila, final, i As Long
'fila = 6
'Do While Hoja3.Cells(fila, 1) <> Empty
'fila = fila + 1
'Loop
'final = fila - 1
' For i = 6 To final
' If UCase(Hoja3.Cells(i, 3)) Like "*" & UCase(txtproductos) & "*" Then
' With listcargaproductos
' .ColumnCount = 6
'
' .AddItem
' .List(.ListCount - 1, 0) = Hoja3.Cells(i, 1)
' .List(.ListCount - 1, 1) = Hoja3.Cells(i, 2)
' .List(.ListCount - 1, 2) = Hoja3.Cells(i, 3)
' .List(.ListCount - 1, 3) = Hoja3.Cells(i, 4)
' .List(.ListCount - 1, 4) = Hoja3.Cells(i, 5)
' .List(.ListCount - 1, 5) = Hoja3.Cells(i, 6)
' End With
'
' Next i
' End If
'
'If txtproductos = "" Then
' With Sheets("Hoja3")
' uf = .Range("A" & Rows.Count).End(xlUp).Row
' uc = .Cells(6, Columns.Count).End(xlToLeft).Column
' le = Columns(uc).Address(False, False)
' le = Left(le, InStr(1, le, ":") - 1)
' For c = 1 To uc
' ancho = ancho & Int(.Cells(3, c).Width + 3) & ";"
' Next
'
' With listcargaproductos
' .RowSource = ""
' .ColumnHeads = True
' .ColumnCount = uc
' .ColumnWidths = ancho
' .RowSource = "Hoja3!A6:" & le & uf
' End With
' End With
'End If
'
'
'txtproductos = IIf(d = 1, txtproductos, "")
'
' campo = Me.Controls("Textbox" & d)
' n = d
' For m = 1 To 2
' With Me.Controls("ListBox" & m)
' .RowSource = ""
' End With
' Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Set b = Sheets("Hoja3")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
Me.listcargaproductos.RowSource = "Hoja3!A2:C" & uf
Me.listcargaproductos.ColumnCount = 6
Me.listcargaproductos.ColumnWidths = "20 pt; 50 pt; 50 pt;50 pt;50 pt;50 pt"
Exit Sub
End If
b.AutoFilterMode = False
Me.listcargaproductos = Clear
Me.listcargaproductos.RowSource = Clear
'dato1 = CDate(TextBox2)
'dato2 = CDate(TextBox3)
'Elimina hoja y crea hoja dando el mismo nombre que la eliminada
Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
'Sheets("FANTASMA666444FANTASMA").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"
'ActiveSheet.Name = "FANTASMA666444FANTASMA"
'Set a = Sheets("FANTASMA666444FANTASMA")
Set a = Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD")
b.Range("A1:F1").Copy Destination:=a.Range("A1")
fila = 1
For i = 2 To uf
strg = b.Cells(i, 3).Value
If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
a.Cells(fila, 1) = b.Cells(i, 1)
a.Cells(fila, 2) = b.Cells(i, 2)
a.Cells(fila, 3) = b.Cells(i, 3)
a.Cells(fila, 4) = b.Cells(i, 4)
a.Cells(fila, 5) = b.Cells(i, 5)
a.Cells(fila, 6) = b.Cells(i, 6)
fila = fila + 1
End If
Next i
'a.Range("D:G").NumberFormat = "dd/mm/yyyy"
uf = a.Range("A" & Rows.Count).End(xlUp).Row
uc = a.Cells(6, Columns.Count).End(xlToLeft).Address
le = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.listcargaproductos
.ColumnCount = 6
'.RowSource = ""
.ColumnHeads = True
.ColumnWidths = "20 pt; 50 pt; 50 pt;50 pt;50 pt;50 pt"
'.RowSource = "Hoja3!A2:" & wc & uf
.RowSource = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD!F1:" & le & uf
End With
a.Delete
End Sub
Private Sub UserForm_Activate()
'With Sheets("Hoja3")
' uf = .Range("A" & Rows.Count).End(xlUp).Row
' uc = .Cells(6, Columns.Count).End(xlToLeft).Column
' le = Columns(uc).Address(False, False)
' le = Left(le, InStr(1, le, ":") - 1)
' For c = 1 To uc
' ancho = ancho & Int(.Cells(3, c).Width + 3) & ";"
' Next
'
' With listcargaproductos
' .RowSource = ""
' .ColumnHeads = True
' .ColumnCount = uc
' .ColumnWidths = ancho
' .RowSource = "Hoja3!A6:" & le & uf
' End With
' End With
'Me.listcargaproductos =
'Me.listcargaproductos.ColumnCount = 6
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Hoja3")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(2, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.listcargaproductos
.ColumnCount = 6
.ColumnWidths = "20 pt; 50 pt; 50 pt;50 pt;50 pt;50 pt"
.ColumnHeads = True
.RowSource = "Hoja3!A2:" & wc & uf
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'Dim fila, final, i As Long
'fila = 6
'Do While Hoja3.Cells(fila, 1) <> Empty
'fila = fila + 1
'Loop
'final = fila - 1
' For i = 6 To final
' With listcargaproductos
' .ColumnCount = 6
' .ColumnWidths = "60;90;90;75;60;60"
' .ColumnHeads = True
' .AddItem
' .List(.ListCount - 1, 0) = Hoja3.Cells(i, 1)
' .List(.ListCount - 1, 1) = Hoja3.Cells(i, 2)
' .List(.ListCount - 1, 2) = Hoja3.Cells(i, 3)
' .List(.ListCount - 1, 3) = Hoja3.Cells(i, 4)
' .List(.ListCount - 1, 4) = Hoja3.Cells(i, 5)
' .List(.ListCount - 1, 5) = Hoja3.Cells(i, 6)
' End With
'
' Next i
'Me.listcargaproductos.RowSource = "hoja3!A2"
'Me.listcargaproductos.ColumnCount = 6 With Sheets("Recetas")
End Sub
'Sub filtro2(hoja, lis, fil)
'
'hfil = "fil" & fil
'Sheets(hfil).Cells.Clear
'With Sheets(hoja)
' uc = .Cells(1, Columns.Count).End(xlToLeft).Column
' le = Columns(uc).Address(False, False)
' le = Left(le, InStr(1, le, ":") - 1)
' With .Range("C4:C" & .Range("C" & Rows.Count).End(xlUp).Row)
' 'With .Range("A1" & .Range("A" & Rows.Count).End(xlUp).Row)
' .AutoFilter Field:=n, Criteria1:=campo
' .Copy Sheets(hfil).Range("A1")
' End With
' If .AutoFilterMode Then .Range("A1").AutoFilter
' ancho = ancho & Int(.Cells(3, c).Width + 3) & ";"
' 'ancho = ancho & Int(.Cells(1, "C").Width + 3) & ";"
'End With
'
'uf = Sheets(hfil).Range("A" & Rows.Count).End(xlUp).Row
'If uf < 2 Then Exit Sub
'With Me.Controls("ListBox" & lis)
' .RowSource = ""
' .ColumnHeads = True
' .ColumnCount = 6
' .ColumnWidths = ancho
' .RowSource = hfil & "!A6:A" & uf
'End With
'End Sub
No entiendo qué estás haciendo.
Solamente tienes que probar el archivo que te compartí, mi archivo funciona bien!
Sigues sin poner la variable 'a' hasta arriba de todo el código, cosa que no entiendo, porque fue lo que te pedí desde un inicio.
Tú código tiene problemas, si lo mezclas con mi código, obviamente seguirás teniendo problemas. Lo que debes hacer es quitar todo tu código y poner solamente mi código.
En tu código estás utilizando la variable 'a' como un objeto, entonces tienes la variable 'a' para 2 cosas. Por eso debes quitar todo tu código y poner solamente mi código.
Si quieres que adapte el código en tu archivo, entonces comparte tu archivo en google drive, comparte el archivo para cualquiera que tenga el enlace, copia el enlace y lo pegas aquí.
O envíame tu archivo a mi correo:
¡Gracias! ¿Muchas gracias maestro solicitando disculpas el enredo de algo sencillo si no que era de conocer donde me generaba error al realizar un evento para seguir en mi proyecto los códigos los enviaba comentados y así iba viendo línea línea y buscando mi lógica de programar en este momento estoy estudiando línea a línea el código enviado por usted para entender y poderlo aplicar a futuros proyectos de nuevo gracias me es de mu mucha ayuda... no se si así quede cerrada la pregunta?
[Encantado de ayudarte, gra cias por comentar.
Buen día por fa recurriendo a usted de nuevo me gustaría preguntar si es posible insertar el signo moneda en dos columnas especificas o toca realizar otro método para insertarlo muchas gracias
Realmente no sé cómo dejaste la macro.
Crea una nueva pregunta y específica bien qué necesitas.
1 respuesta más de otro experto
Como no dejaste ningún tipo de ejemplo o imagen de cómo se encuentran tus datos ni los controles de tu formulario, no podemos hacer mucho desde aquí.
Te invito a mirar el video N° 36 de mi canal y desde el enlace al Blog podrás descargar el libro de ejemplo con el código explicado.
Si no logras adaptarlo a tu modelo debieras enviarme tu libro (solo con un par de datos no reales) con lo que necesitas obtener, o explicarlo todo un poco más aquí.
Sdos y comenta si el tema queda resuelto. En ese caso no olvides valorar esta respuesta.