Sinceramente es urgente
Buenas, digo así, porque no se a que hora sea leído esto. Necesito la ayuda de alguien que me diga como hacer una macro para realizar una búsqueda en una columna en particular, he estado viendo las respuestas y he intentado cada una de ellas, pero hasta ahora ninguna me ha resultado, y es muy importante, pues necesito entregar este proyecto mañana por la tarde. Incluyo la macro original que he estado modificando, pero con cada modificación me aparecen nuevos errores, además de que es una macro ya usada, por lo que debo cambiarle los valores de texto únicamente, pero es al modificar estos que me indica el error y por más que lo busco no puedo encontrarlo, agradezco de ante mano su ayuda.
Sub busqueda()
I = 6
K = 6
Grupo = InputBox("Dame el grupo a buscar ")
While Sheets.Item("Base de Datos").Cells(I, 1) <> ""
If Sheets.Item("Base de Datos").Cells(I, 2) = Grupo Then
For j = 1 To 12
Sheets.Item("Hoja4").Cells(K, j) = Sheets.Item("Base de Datos").Cells(I, j)
Next j
K = K + 1
End If
I = I + 1
Wend
End Sub
Sub busqueda()
I = 6
K = 6
Grupo = InputBox("Dame el grupo a buscar ")
While Sheets.Item("Base de Datos").Cells(I, 1) <> ""
If Sheets.Item("Base de Datos").Cells(I, 2) = Grupo Then
For j = 1 To 12
Sheets.Item("Hoja4").Cells(K, j) = Sheets.Item("Base de Datos").Cells(I, j)
Next j
K = K + 1
End If
I = I + 1
Wend
End Sub
1 respuesta
Respuesta de santiagomf
1
He retocado tu búsqueda y he incluido comentarios de lo que hace cada línea.
No cuentas nada de lo que quieres hacer, por lo que no puedo ver si hace exactamente lo que quieres o no.
Te dejo el código y espero que con las explicaciones seas capaz de ajustarlo.
Un saludo
Option Explicit
Sub busqueda()
Dim nLinBD As Long
Dim nCol As Long
Dim nLinH4 As Long
Dim grupo As String
' Antes de nada borraremos de la página "Hoja4" todos los datos de las 12
' columnas (de la A a la L) entre las filas 6 y 5000 para borrar los
' resultados de consultas anteriores
Sheets("hoja4").Range("A6:L5000").ClearContents
nLinBD = 6 ' Empezamos a comprobar en la línea 6 de "Base de Datos"
nLinH4 = 6 ' La primera línea encontrada se escribirá en la linea 6 de "Hoja4"
' Leemos el nombre del grupo que buscaremos en la columna "B" de "Base de Datos"
grupo = InputBox("Dame el grupo a buscar ")
If grupo = "" Then Exit Sub ' Si no teclean nada o pulsan cancelar... terminamos
' Repetimos mientras haya algo en la columna 1, en la fila a consultar
' (si la celda Axxxx está vacía dejará de buscar y terminará el proceso)
While Sheets("Base de Datos").Cells(nLinBD, 1) <> ""
' Si la celda Bxxxx tiene 'exactamente' lo mismo que hemos tecleado...
' Habremos encontrado el grupo y copiaremos los datos
' OJO: tiene que ser 'exactamente' lo mismo. Si cambian las mayúsculas
' Y minúsculas no será igual (PEPE no es igual que Pepe)
' Si quieres que no haga distinción entre mayúsculas y minúsculas utiliza
' La función Ucase$() para comparar los datos convertidos en
' mayúsculas. Sería: If ucase$(Sheets("Base de Datos").Cells(nLinBD, 2)) = ucase$(grupo)...
If Sheets("Base de Datos").Cells(nLinBD, 2) = grupo Then
' Para copiar 12 columnas de la fila "nLinBD" de la página "Base de Datos"
' a la fila "nLinH4" de la página "hoja4"
For nCol = 1 To 12
Sheets("Hoja4").Cells(nLinH4, nCol) = Sheets("Base de Datos").Cells(nLinBD, nCol)
Next nCol
nLinH4 = nLinH4 + 1 ' La próxima vez escribiremos en la siguiente línea
End If
nLinBD = nLinBD + 1 ' Comprobamos la siguiente línea de la página "Base de Datos"
Wend
End Sub
No cuentas nada de lo que quieres hacer, por lo que no puedo ver si hace exactamente lo que quieres o no.
Te dejo el código y espero que con las explicaciones seas capaz de ajustarlo.
Un saludo
Option Explicit
Sub busqueda()
Dim nLinBD As Long
Dim nCol As Long
Dim nLinH4 As Long
Dim grupo As String
' Antes de nada borraremos de la página "Hoja4" todos los datos de las 12
' columnas (de la A a la L) entre las filas 6 y 5000 para borrar los
' resultados de consultas anteriores
Sheets("hoja4").Range("A6:L5000").ClearContents
nLinBD = 6 ' Empezamos a comprobar en la línea 6 de "Base de Datos"
nLinH4 = 6 ' La primera línea encontrada se escribirá en la linea 6 de "Hoja4"
' Leemos el nombre del grupo que buscaremos en la columna "B" de "Base de Datos"
grupo = InputBox("Dame el grupo a buscar ")
If grupo = "" Then Exit Sub ' Si no teclean nada o pulsan cancelar... terminamos
' Repetimos mientras haya algo en la columna 1, en la fila a consultar
' (si la celda Axxxx está vacía dejará de buscar y terminará el proceso)
While Sheets("Base de Datos").Cells(nLinBD, 1) <> ""
' Si la celda Bxxxx tiene 'exactamente' lo mismo que hemos tecleado...
' Habremos encontrado el grupo y copiaremos los datos
' OJO: tiene que ser 'exactamente' lo mismo. Si cambian las mayúsculas
' Y minúsculas no será igual (PEPE no es igual que Pepe)
' Si quieres que no haga distinción entre mayúsculas y minúsculas utiliza
' La función Ucase$() para comparar los datos convertidos en
' mayúsculas. Sería: If ucase$(Sheets("Base de Datos").Cells(nLinBD, 2)) = ucase$(grupo)...
If Sheets("Base de Datos").Cells(nLinBD, 2) = grupo Then
' Para copiar 12 columnas de la fila "nLinBD" de la página "Base de Datos"
' a la fila "nLinH4" de la página "hoja4"
For nCol = 1 To 12
Sheets("Hoja4").Cells(nLinH4, nCol) = Sheets("Base de Datos").Cells(nLinBD, nCol)
Next nCol
nLinH4 = nLinH4 + 1 ' La próxima vez escribiremos en la siguiente línea
End If
nLinBD = nLinBD + 1 ' Comprobamos la siguiente línea de la página "Base de Datos"
Wend
End Sub
