Como crear una coleccion de datos y buscar uno por uno





En esta oportunidad se mostrará como crear un listado o colección de datos para luego poder usar ese listado y hacer un bucle para buscar datos uno por uno de todos los registros de la colección de datos.

Como se verá en el ejemplos de crea una colección de datos con todos los nombres de las aseguradoras listadas, luego se usa esos nombre de aseguradoras para buscar en la base de datos los registros relacionados, a su vez en este ejemplo resalta el nombre de las aseguradoras encontrados y los copia en la hoja2, ello es posible mediante la macro que crea un listado o colección de datos que luego son usados en un bucle.

Antes de seguir recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

Una vez descargado el ejemplo, se podrá observar en el libro de Excel en la hoja 1, uno que ejecuta la macro el otro que vuelve a borrar los datos y dejarlos en el estado original para poder ejecutar la macro uno y otra vez sin problemas; por supuesto que como siembre se puede descargar el ejemplo en forma gratuita desde el final de post.

Se observa que existe en la columna A un listado de compañías aseguradoras, y en la columna B otro listado de compañías aseguradoras, el ejemplo consiste en hacer un listado o colección de datos únicos, es decir sin duplicados, con las compañías aseguradoras que se encuentran en la columna A.

El código que genera la colección de datos es el siguiente, previamente se cargó en la variable r1 el rango donde se encuentran los datos para crear la colección de datos:

For Each celda In Range(r1)
cod.Add celda.Value, CStr(celda.Value)
Next celda

Quizás también interese:
Como usar la función VLookup o BuscarV al presionar enter
Como usar la función VLookup o BuscarV con base datos en otra hoja
Como buscar datos con Vlookup y conservar los hipervinculos en los datos que ese obtienen de la base de datos

El ejemplo toma cada uno de esos nombres de compañías aseguradoras que forman parte de la colección de datos y hace un bucle con cada uno de ellos, es decir recorre desde el primer elemento de la lista hasta el último, una vez encontrado en la columna B el nombre de la compañía aseguradora que se está buscando lo resalta y lo copia en la hoja2; esto es posible con el siguiente código:

For Each dato In cod
busco = dato
Set codigo = Range(r2).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
dire = codigo.Row
Cells(codigo.Row, "B").Interior.Color = 255
Cells(codigo.Row, "B").Copy Destination:=Sheets("Hoja2").Range("A" & j)
j = j + 1
Sheets("Hoja2").Cells.Interior.Color = xlNone
End If
Next dato

Si se observa el código anterior con "For Each dato In cod"; se le dice a la macro por cada uno de los elementos de la colección, que los resalte en la columna B y los copia a la hoja2; en resumen se crea una colección de datos y luego se busca estos datos en la base de datos uno por uno.

El vídeo que sigue muestra una explicación más detallada y gráfica de la macro presentada, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo guardar un archivo con una fecha en su nombrebuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, como pasar datos de listbox a hoja de Excel y muchos ejemplos más.







 


Código que se inserta en un módulo

Sub BuscaDato()
Dim cod As New Collection, celda, dato
Application.ScreenUpdating = False
On Error Resume Next
Set a = Sheets("Hoja1")
uf = a.Range("B" & Rows.Count).End(xlUp).Row
ufb = a.Range("A" & Rows.Count).End(xlUp).Row
r1 = "A2:A" & ufb
r2 = "B2:B" & uf
For Each celda In Range(r1)
cod.Add celda.Value, CStr(celda.Value)
Next celda
j = 1
For Each dato In cod
busco = dato
Set codigo = Range(r2).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
If Not codigo Is Nothing Then
dire = codigo.Row
Cells(codigo.Row, "B").Interior.Color = 255
Cells(codigo.Row, "B").Copy Destination:=Sheets("Hoja2").Range("A" & j)
j = j + 1
Sheets("Hoja2").Cells.Interior.Color = xlNone
End If
Next dato

Application.ScreenUpdating = True
End Sub


Sub BorraColor()
Range("B1:B1000").Interior.Color = xlNone
Sheets("Hoja2").Cells.Clear
End Sub

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends