¿Cómo ejecutar búsquedas potentes de datos en diferentes hojas?
Los expertos en Excel y VBA!
La situación es la siguiente:
Tengo un libro de repuesto de unas 30 hojas (de igual distribución) con unos 200 registros por hoja.
Cada hoja es una maquina diferente.
La destrucción de cada hoja es como se ve en la imagen.
Desde cualquiera de esa hojas lanzo un formulario "Busqueda_elementos" donde me carga las marcas de esa hoja en un listbox y hay un textbox para introducir manualmente la referencia.
Con los datos de búsqueda del formulario (eligiendo marca en listbox y con la referencia del textbox) quiero encontrar en el resto de páginas (en columna DE están las referencias y en E las marcas) que repuestos encajan y cargarlos en un listbox que estará en el formulario.
Debiendo cargar el nombre de la hoja donde se encuentra en el listbox.
Esto debe ejecutarse de manera rápida así que evitemos Loop... ¿qué se os ocurre?
Si necesitáis más decirme.
1 Respuesta
Para realizar las búsquedas y las cargas en listbox, lo más rápido, es utilizar matrices.
Según tu comentario, tienes 30 hojas con 200 registros, tienes alrededor de 6 mil registros.
Hice pruebas con una base de 40 hojas y 1,000 registros en cada hoja, un total de 40 mil registros.
El siguiente código realiza las búsquedas casi inmediatas.
Prueba el código, en tu libro. Crea un formulario nuevo con lo siguiente:
- Un listbox1 (con 1 columna)
- Un listbox2
- Un textbox1 (con 6 columnas)
Te pido las pruebas en un form nuevo, porque no conozco la estructura de tus controles. Ni cómo quieres hacer la búsqueda. Ni el código que ya tienes. Entonces para efectos de las pruebas, crea un form nuevo.
Antes de ejecutar el form. Modifica en estas líneas (son 2 líneas) los nombres de las hojas, por los nombres de las hojas de tu libro que no contienen datos de una máquina.
Yo puse unos ejemplos:
Case "Hoja1", "1", "Hoja2", "etc"
Pon TODO el siguiente código en el form nuevo:
Option Explicit
Dim b As Variant
'
Private Sub TextBox1_Change()
Dim i As Long, j As Long, k As Long
Dim c As Variant, d As Variant
'
ListBox2.Clear
If ListBox1.ListIndex = -1 Then
MsgBox "Selecciona una marca"
Exit Sub
End If
ReDim c(1 To UBound(b), 1 To 6)
For i = 1 To UBound(b, 1)
If b(i, 5) = ListBox1.List(ListBox1.ListIndex, 0) And InStr(1, b(i, 4), TextBox1.Value) > 0 Then
k = k + 1
For j = 1 To 6
c(k, j) = b(i, j)
Next
End If
Next
'
If k > 0 Then
ReDim d(1 To k, 1 To 6)
For i = 1 To k
For j = 1 To 6
d(i, j) = c(i, j)
Next
Next
ListBox2.List = d
End If
End Sub
'
Private Sub UserForm_Activate()
Dim a As Variant
Dim sh As Worksheet
Dim i As Long, j As Long, k As Long, n As Long
'
ListBox1.RowSource = Range("E6:E" & Range("E" & Rows.Count).End(3).Row).Address
a = Range("a1:a2").Value2
'
For Each sh In Sheets
Select Case sh.Name
Case "Hoja1", "1", "Hoja2", "etc"
'Poner las hojas que no son de máquina
Case Else
n = n + sh.Range("E" & Rows.Count).End(3).Row - 5
End Select
Next
'
ReDim b(1 To n, 1 To 6)
'
For Each sh In Sheets
Erase a
Select Case sh.Name
Case "Hoja1", "1", "Hoja2", "etc"
'Poner las hojas que no son de máquina
Case Else
Erase a
a = sh.Range("A6", sh.Range("E" & Rows.Count).End(3)).Value2
For i = 1 To UBound(a, 1)
k = k + 1
For j = 1 To UBound(a, 2)
b(k, 6) = sh.Name
b(k, j) = a(i, j)
Next
Next
End Select
Next
'
ListBox2.List = b
End SubFunciona de la siguiente manera:
- Abre tu form.
- En automático las marcas son cagadas en el listbox1
- Selecciona una marca en el listbox1
- Empieza a escribir en el textbox1
- En automático el listbox2 se actualiza.
Prueba y me comentas
Impresionante gracias... sin embargo me resulta muy difícil de seguir.
Esto es lo que tengo...
En el listbox superior encontramos todas las hojas en las que tenemos los datos, ahora son 3 pero serán 30 con unos 200 registros por hoja.
Selecciono una hoja, en este caso "2M Sodadura por ultrasonidos"... nos carga todas las marcas comerciales de esa hoja elegida en el ComboBox Marca. Seleccionamos una marca ·DESTACO· y ponemos los primeros caracteres de la referencia comercial a buscar en el textbox Referencia.
Tenemos que buscar en todas las hojas mostradas en el listbox superior (excepto la elegida) todos los registros que coincidan con marca y con referencia mostrada en el textbox.
La información en las hojas se puede ver en esta imagen.
Los resultados encontrados irán a un ListBox llamado "ElementosEncontrados"... con 6 columnas en el mismo formulario.
1º columna en que hoja se encuentra ... nombre
2º columna submaquina... en las sheets columna B
3º columna nombre en Excel Mto... en las sheets columna C
4º columna ·Referencia Almacen Mto... en las sheets columna D
5º columna Marca... en las sheets columna E
6º columna Cantidad... en las sheets columna F
A esto quiero llegar encontrando la indo de una manera rápida.
Gracias por tu info y aporte... te animo a que continúes con migo.
Un saludo.
Puedes compartir tu archivo en googledrive. Reemplaza tu información confidencial por datos genéricos.
Tengo que adaptar el código a tus controles y hojas.
Estoy atascado ... solicito colaboración... gracias
Pon el siguiente código en tu userform. Cambia en el código listbox1 (superior), listbox2 (inferior), combobox1 y texbox1 por el nombre de tus controles.
Quita todo tu código y pon el nuevo:
Dim b As Variant
'
Private Sub ListBox1_Click()
Dim sh As Worksheet
If ListBox1.ListIndex <> -1 Then
Set sh = Sheets(ListBox1.Value)
ListBox2.Clear
TextBox1.Value = ""
ComboBox1.Clear
ComboBox1.List = sh.Range("E6", sh.Range("E" & Rows.Count).End(3)).Value
End If
End Sub
'
Private Sub TextBox1_Change()
Dim i As Long, j As Long, k As Long
Dim c As Variant, d As Variant
'
ListBox2.Clear
If ListBox1.ListIndex = -1 Then MsgBox "Selecciona una hoja": Exit Sub
If ComboBox1.ListIndex = -1 Then MsgBox "Selecciona una marca": Exit Sub
If TextBox1.Value = "" Then Exit Sub
'
ReDim c(1 To UBound(b), 1 To 6)
For i = 1 To UBound(b, 1)
'filtra la matriz b y carga en la matriz c
If b(i, 1) <> ListBox1.Value And b(i, 5) = ComboBox1.Value And _
InStr(1, LCase(b(i, 4)), LCase(TextBox1.Value)) > 0 Then
k = k + 1
For j = 1 To 6
c(k, j) = b(i, j)
Next
End If
Next
'
If k > 0 Then
ReDim d(1 To k, 1 To 6)
For i = 1 To k
For j = 1 To 6
d(i, j) = c(i, j)
Next
Next
ListBox2.List = d
Else
MsgBox "No se encontraron referencias"
End If
End Sub
'
Private Sub UserForm_Activate()
Dim a As Variant
Dim sh As Worksheet, itm As Variant
Dim i As Long, j As Long, k As Long, n As Long, m As Long
'
For Each sh In Sheets
If LCase(sh.Range("E5").Value) = LCase("Marca") Then
n = n + sh.Range("E" & Rows.Count).End(3).Row - 5
ListBox1.AddItem sh.Name
End If
Next
'
ReDim b(1 To n, 1 To 6)
a = Range("A1:A2").Value2
'
For m = 0 To ListBox1.ListCount - 1
Set sh = Sheets(ListBox1.List(m))
Erase a
'Carga en la matriz a los datos de una hoja
a = sh.Range("B6", sh.Range("F" & Rows.Count).End(3)).Value2
For i = 1 To UBound(a, 1)
k = k + 1
'Acumula en la matriz b, todas las marcas de todas las hojas
'Orden: 1-hoja, 2-colB, 3-colC, 4-colD, 5-colE, 6-colF
b(k, 1) = sh.Name
For j = 1 To UBound(a, 2)
b(k, j + 1) = a(i, j)
Next
Next
Next
End Sub
Hola!... he intentado incorporar tu código al mio y me genera un montón de errores.
Te paso el enlace de drive para que veas como tengo mi libro.
https://drive.google.com/file/d/1nGa6M7TqEK5SX3JSuYJUla-IIGnXVIid/view?usp=sharing
1º Pincha en el botón de la hoja presentación... mostrara el formulario
2º En el formulario... elige la hoja 23M automáticamente se cargan todas las hojas en el combobox de marcas.
3º Selecciona una marca... por ejemplo Turck, mostrándonos las referencias que tenemos de esta marca en la hoja seleccionada 23M
4º En ese textbox de filtrado deja solo los caracteres FLD
5º Al salir del textbox se genera un evento en el cual nos buscara todos los repuestos con marca Turck y que comiencen por los caracteres FLD incorporando la info en el listbox azul.
'Orden: 1-hoja, 2-colB, 3-colC, 4-colD, 5-colE, 6-colF
Como lo habías descrito.
Tengo que agradecer mucho tu esfuerzo e interés en ayudarme.
Dentro de lo que puedas pon comentarios en la programación para que pueda seguir la programación. Admito que los Arrays no es mi fuerte y eso que estoy viendo tutoriales sobre este tema gracias a ti
Muchas gracias Dante!
Responde en el siguiente orden:
1. Cuáles hojas son como esta:
2. ¿Todas esas hojas tendrán en la celda "E5" la palabra "Marca"'
3. Dime el nombre de tus controles:
Listbox1 (superior), listbox2 (inferior), combobox1 y texbox1
Hola Dante!
1º Todas las con etiqueta de color verde o amarillo.
Las que tienen datos y por tanto entre las que hay que buscar aparecen en el ListBox "ListHojasConRepuestos"
2º Correcto... en "E5" aparecerá "Marca" y es la misma estructura en todas.
3º Listbox 1= ListHojasConRepuestos
Listbox2=ListRepuestosCoincidentes (azul)...donde se encontraran los datos filtrados
ComboBox1=MarcaRepuestoCritico
Textbox1=RefAlmacen
Si tienes más dudas... te grabo un video si hace falta.
Gracias y sorpréndeme!
Estoy estudiando un nivel superior de programación con tutoriales de youtube todo para coger más conocimientos dentro de este recurso limitado que es nuestro tiempo.
Un saludo
Te anexo el archivo con el código adaptado.
1. Tuve que mover todo tu código del form. Lo puse en el módulo "codAnterior"
2. En tus hojas de marcas, tienes la fila 6 vacía, no sé cuál es su finalidad, pero no es recomendable tener filas vacías en medio de una base de datos.
3. Puse algunos comentarios en el código, pero si alguna parte no es clara, me puedes preguntar.
4. Hice pruebas con las hojas que vienen en tu archivo y funciona tal cual lo pediste.
5. Tal vez al iniciar el form sea un poco lento, es porque está cargando toda la información de las hojas en una matriz.
6. Las búsquedas son inmediatas!
Va el código actualizado:
Option Explicit
'
'Declaración de variables globales, deben ir al incio de todo el código
Dim b As Variant
'
'
Private Sub ListHojasConRepuestos_Click()
Dim sh As Worksheet
Dim a As Variant
Dim dic As Object
Dim i As Long, p As Long
'
'Crea un índice para cargar Marcas únicas en el combo
Set dic = CreateObject("Scripting.Dictionary")
'
If ListHojasConRepuestos.ListIndex <> -1 Then
Set sh = Sheets(ListHojasConRepuestos.Value)
ListRepuestosCoincidentes.Clear
MarcaRepuestoCritico.Clear
RefAlmacen.Value = ""
'
If sh.Range("E" & Rows.Count).End(3).Row > 5 Then
'Carga en la matriz a() todas las marcas de la hoja seleccionada
a = sh.Range("E6", sh.Range("E" & Rows.Count).End(3)).Value
For i = 1 To UBound(a)
'carga en el índice solamente las marcas únicas
If a(i, 1) <> "" Then dic(a(i, 1)) = Empty
Next
'carga en el combo las marcas únicas
MarcaRepuestoCritico.List = dic.keys
End If
End If
End Sub
'
Private Sub RefAlmacen_Change()
Dim i As Long, j As Long, k As Long
Dim c As Variant, d As Variant
'
ListRepuestosCoincidentes.Clear
If RefAlmacen.Value = "" Then Exit Sub
If ListHojasConRepuestos.ListIndex = -1 Then MsgBox "Selecciona una hoja": Exit Sub
If MarcaRepuestoCritico.ListIndex = -1 Then MsgBox "Selecciona una marca": Exit Sub
'
ReDim c(1 To UBound(b), 1 To 6)
For i = 1 To UBound(b, 1)
'filtra la matriz b y carga en la matriz c
If b(i, 1) <> ListHojasConRepuestos.Value And b(i, 5) = MarcaRepuestoCritico.Value And _
InStr(1, LCase(b(i, 4)), LCase(RefAlmacen.Value)) > 0 Then
k = k + 1
For j = 1 To 6
c(k, j) = b(i, j)
Next
End If
Next
'
If k > 0 Then
ReDim d(1 To k, 1 To 6)
For i = 1 To k
For j = 1 To 6
d(i, j) = c(i, j)
Next
Next
ListRepuestosCoincidentes.List = d
Else
MsgBox "No se encontraron referencias"
End If
End Sub
'
Private Sub UserForm_Activate()
Dim a As Variant
Dim sh As Worksheet, itm As Variant
Dim i As Long, j As Long, k As Long, n As Long, m As Long, p As Long
'
With ListHojasConRepuestos
For Each sh In Sheets
If LCase(sh.Range("E5").Value) = LCase("Marca") Then
n = n + sh.Range("E" & Rows.Count).End(3).Row - 5
.AddItem sh.Name
End If
Next
'
ReDim b(1 To n, 1 To 6)
a = Range("A1:A2").Value2
'
For m = 0 To .ListCount - 1
Set sh = Sheets(.List(m))
Erase a
'Carga en la matriz a() los datos de una hoja
p = sh.Range("F" & Rows.Count).End(3).Row
If p > 5 Then
a = sh.Range("B6", sh.Range("F" & Rows.Count).End(3)).Value2
For i = 1 To UBound(a, 1)
k = k + 1
'Acumula en la matriz b, todas las marcas de todas las hojas
'Orden: 1-hoja, 2-colB, 3-colC, 4-colD, 5-colE, 6-colF
b(k, 1) = sh.Name
For j = 1 To UBound(a, 2)
b(k, j + 1) = a(i, j)
Next
Next
End If
Next
End With
End SubVa el archivo versión 2:
https://drive.google.com/file/d/1YUV1URAsbTR8Uyh6lmla-SvMFAcyhROE/view?usp=sharing
¡Gracias!
Tengo que darte las gracias Dante por:
1º Atender mi question
2º Darme una solución.
Ayer estuve estudiando tu código porque no termina de hacer lo que yo quiero. Eso si me das las herramientas de como hacerlo.
Conclusiones:
1º Me tengo que poner las pilas con los arrays y mucho.
2º Solo se que no se nada.
Gracias y hasta la próxima embarcada.
Un saludo
.
Ayer estuve estudiando tu código porque no termina de hacer lo que yo quiero. Eso si me das las herramientas de como hacerlo.
¿Qué faltaría por hacer? Si lo explicas con un ejemplo para que yo lo pueda entender.
Si lo que necesitas no fue explicado en la pregunta original, entonces crea una nueva pregunta con el detalle.
Hola Dante!
Te paso un video explicando mas detalladamente lo que necesito.
https://drive.google.com/file/d/1jq70Nbxf3C1X_d638Cmpiqb3Cuty2LF0/view?usp=sharing
Te paso mi libro tal y como lo tengo ahora.
https://drive.google.com/file/d/1oXTsgMzj9fh5dLf-ljO9iZc2RJZ38i5p/view?usp=sharing
Los valores a mostrar en el Listbox azul serian en este orden:
1º columna en que hoja se encuentra ... nombre
2º columna submaquina... en las sheets columna B
3º columna nombre en Excel Mto... en las sheets columna C
4º columna ·Referencia Almacen Mto... en las sheets columna D
5º columna Marca... en las sheets columna E
6º columna Cantidad... en las sheets columna F
Gracias nuevamente....un saludo
Sin ver el vídeo.
Eso es exactamente lo que hace la macro.
¿Cuál de esas columnas que mencionas no está poniendo la macro.
Hola de nuevo!
Echa un vistazo al video que te envío sobre lo que hiciste y escucha mis explicaciones que te doy.
https://drive.google.com/file/d/1TGqtrfiB1oRRoQ9jJoeoXe9lrlJy-xB5/view?usp=sharing
A ver si ahora nos aclaramos... gracias de nuevo.
Un saludo
Te envié una solicitud para el acceso al vídeo
De acuerdo con tu vídeo la hoja "4M Puente grua" no debe aparecer en el listbox.
Esta es tu petición:
En el listbox superior encontramos todas las hojas en las que tenemos los datos, ahora son 3 pero serán 30 con unos 200 registros por hoja.
En ninguna parte mencionas que el nombre de la hoja no debe aparecer si no contiene datos.
Pero eso se puede solucionar de una manera fácil.
Lo importante son las búsquedas.
Probaste todo lo demás. Es decir, si te posicionas en la hoja "23M Prensa 800 Tn" y ejecutas el formulario, la macro hace todo lo demás que solicitaste.
Prueba y me comentas. Incluso realiza un vídeo de esa prueba y me lo envías.
