Macro para comparar dos bases de datos
Tengo dos bases de datos mi Base que me envían día a día y una Base Original, la cual debo actualizar a diario, quiero una macro para que me resalte en color cuales de los datos que tengo en la Base Enviada no los tengo en mi Base original.
Los archivos tienen las mismas columnas (A hasta BI) en total 61 columnas y es muy tardado haciéndolo con VLOOKUP, ojala puedas ayudarme.
1 respuesta
H o l a:
¿Y cuál o cuáles columnas hay que revisar?
La idea sería la siguiente:
- En el archivo "Base original" pondrías la macro.
- Ejecutas la macro,
- La macro te solicitaría que abrieras el archivo "base enviada"
- La macro realiza la comparación
- Pinta de color los registros que está en la "base enviada" y que no están en la "Base original"
Es correcta la idea?
Sal u dos
Se revisan todas las columnas ya que los valores que actualicen pueden estar en varias o algunas.
Exacto la idea es la correcta.
Saludos
¿Pero entonces cómo hago la revisión?
Los de la columna A de "enviada" contra la columna A de "Original", la B contra la B.
¿O los de la columna A de "enviada" contra todas las columnas de "Original"?
-Los de la columna A de "enviada" contara la columna A de "original", la B contra la B, la C contra la C......
Te anexo la macro.
Pon la macro en el archivo "original"
Ejecuta la macro, la macro te solicitará que selecciones el archivo "enviada".
La macro comparará las columnas, desde la A y hasta BI, desde la fila1 y hasta la última fila, de la primer hoja de "enviada" contra las columnas de la primer hoja de "original".
Sub Comparar()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "Excel.*", "*.xls*"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & "\"
If .Show Then
Set l2 = Workbooks.Open(.SelectedItems.Item(1))
Set h2 = l2.Sheets(1)
For j = 1 To Columns("BI").Column
For i = 1 To h2.Cells(Rows.Count, j).End(xlUp).Row
Set b = h1.Columns(j).Find(h2.Cells(i, j), lookat:=xlWhole)
If b Is Nothing Then
h2.Cells(i, j).Interior.ColorIndex = 6
End If
Next
Next
MsgBox "Fin"
End If
End With
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
Dante te agradezco infinitamente, la macro funciona excelente, me has apoyado mucho, gracias por tu tiempo, por tu gran esfuerzo y por tu gran apoyo.
¡Gracias!
