Hola a todos:
En el post de hoy voy a tratar sobre una consulta que me ha enviado un lector y que es un tema muy recurrente en el mundo de los profesionales que trabajan con plantillas con la misma información, pero que proceden de orígenes o sistemas distintos.
Como es lógico siempre queda la duda de si la información es la misma en ambos archivos, una fecha distinta, un literal mal escrito, etc, etc.
Pues bien, ante esta problemática se puede abordar la solución utilizando dos métodos, o bien con ADO y SQL o utilizando loops que vayan comparando la información de cada archivo. Para este post utilizaré la segunda solución (y en otra entrada futura comentaré la primera alternativa).
Veamos un ejemplo, imaginad que hemos descargado la siguiente base de datos desde dos fuentes distintas, es decir, que tenemos dos archivos y que deberían ser idénticos:
El primero está en la hoja 1:
El segundo está en la hoja 2:
Aunque a simple vista ya podéis ver alguna diferencia, con la siguiente macro podréis comprobar los error o diferencias fácilmente:
Sub Compara_Hoja1()
'Declaramos variables
Dim scadena As String, scadena_2 As String
Dim i As Long, j As Long, n As Long
Dim col As Long, fin As Long, final As Long, d As Long
Dim a As Long, x As Long, p As Long, col_1 As Long, col_2 As Long
'Trabajamos con la Hoja1
With Sheets("Hoja1")
fin = Application.CountA(.Range("A:A"))
final = Application.CountA(Sheets("Hoja2").Range("A:A"))
col_1 = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
col_2 = Sheets("Hoja2").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
'Iniciamos primer loop recorriendo registros hoja1
For i = 2 To fin
'Componemos cadena con toda la fila hoja1
For d = 1 To col_1
scadena = scadena & .Cells(i, d).Value
Next d
'Iniciamos segundo loop buscando valor de scadena de hoja1 en hoja2
For j = 2 To final
'Componemos cadena de toda la fija hoja2
For a = 1 To col_2
scadena_2 = scadena_2 & Sheets("Hoja2").Cells(j, a).Value
Next a
'Si el ID existe en la hoja2 contamos
If .Cells(i, 1) = Sheets("Hoja2").Cells(j, 1) Then p = p + 1
'Si el ID es igual al de la hoja2 pero la cadena no es igual iniciamos un tercer loop
If .Cells(i, 1) = Sheets("Hoja2").Cells(j, 1) And scadena <> scadena_2 Then
'Recorremos toda la fila hasta encontrar la diferencia y la marcamos en rojo
For n = 1 To col_2
If .Cells(i, n) <> Sheets("Hoja2").Cells(j, n) Then .Cells(i, n).Interior.Color = vbRed
Next n
End If
'vaciamos valor de variable scadena_2
scadena_2 = vbNullString
Next j
'Si el ID no existe en hoja2 recorremos cadena y marcamos diferencias
If p = 0 Then
For x = 1 To col_2
If .Cells(i, x) <> Sheets("Hoja2").Cells(j, x) Then .Cells(i, x).Interior.Color = vbRed
Next x
End If
p = 0
scadena = vbNullString
Next i
End With
End Sub
Esta macro compara los datos de la hoja 1 con la hoja 2 y marca las diferencias en la hoja 1. Por supuesto al ser las bases de datos iguales no sería necesario otra macro que realizase la labor inversa, pero no siempre es así, puede que los registros estén ordenados de forma diferente en una u otra hoja, o que falten registros, etc.
La macro inversa sería esta:
Sub Compara_Hoja2()
'Declaramos variables
Dim scadena As String, scadena_2 As String
Dim i As Long, j As Long, n As Long
Dim col As Long, fin As Long, final As Long, d As Long
Dim a As Long, x As Long, p As Long, col_1 As Long, col_2 As Long
'Trabajamos con la Hoja2
With Sheets("Hoja2")
fin = Application.CountA(.Range("A:A"))
final = Application.CountA(Sheets("Hoja1").Range("A:A"))
col_1 = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
col_2 = Sheets("Hoja1").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
'Iniciamos primer loop recorriendo registros hoja2
For i = 2 To fin
'Componemos cadena con toda la fila hoja2
For d = 1 To col_1
scadena = scadena & .Cells(i, d).Value
Next d
'Iniciamos segundo loop buscando valor de scadena de hoja1 en hoja1
For j = 2 To final
'Componemos cadena de toda la fija hoja1
For a = 1 To col_2
scadena_2 = scadena_2 & Sheets("Hoja1").Cells(j, a).Value
Next a
'Si el ID existe en la hoja2 contamos
If .Cells(i, 1) = Sheets("Hoja1").Cells(j, 1) Then p = p + 1
'Si el ID es igual al de la hoja1 pero la cadena no es igual iniciamos un tercer loop
If .Cells(i, 1) = Sheets("Hoja1").Cells(j, 1) And scadena <> scadena_2 Then
'Recorremos toda la fila hasta encontrar la diferencia y la marcamos en rojo
For n = 1 To col_2
If .Cells(i, n) <> Sheets("Hoja1").Cells(j, n) Then .Cells(i, n).Interior.Color = vbRed
Next n
End If
'vaciamos valor de variable scadena_2
scadena_2 = vbNullString
Next j
'Si el ID no existe en hoja2 recorremos cadena y marcamos diferencias
If p = 0 Then
For x = 1 To col_2
If .Cells(i, x) <> Sheets("Hoja1").Cells(j, x) Then .Cells(i, x).Interior.Color = vbRed
Next x
End If
p = 0
scadena = vbNullString
Next i
End With
End Sub
Y el resultado de aplicar esas macros es el siguiente:
Como podéis ver, el código funciona perfectamente y detecta las diferencias en cada registro. La clave para hacer que sea un poco más rápido y los loop no ralenticen el proceso es generar cadenas de texto por cada fila, de este modo lo que comparamos son las filas y no las celdas.
En este caso, utilizamos de guía el ID, pero serviría cualquier identificador que sea común en ambas tablas.
Os dejo otra macro para borrar los colores:
Sub borra_hoja1()
Application.ScreenUpdating = False
With Sheets("Hoja1")
.Range("A2").Select
Range("A2", ActiveCell.SpecialCells(xlLastCell)).Select
With Selection.Interior
.Pattern = xlNone
End With
.Range("A2").Select
End With
End Sub
Descarga el archivo de ejemplo pulsando en: MACRO PARA HALLAR DIFERENCIAS ENTRE DOS BASES DE DATOS
¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.
¡¡Muchas gracias!!
