Resaltar Diferencias Entre Dos Hojas
Tengo dos hojas de registros cada una tiene una columna donde se encuentra el key value(registros únicos). Quiero comparar la información de una hoja con la otra de acuerdo a ese registro y las filas para cada uno (las filas son las mismas con el mismo encabezado para cada hoja).
Actualmente tengo este código:
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(2)
fin = Application.CountA(.Range("A:A"))
final = Application.CountA(Sheets(3).Range("A:A"))
col_1 = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column
col_2 = Sheets(3).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(3).Cells(j, A).Value
Next A
'Si el ID existe en la hoja2 contamos
If .Cells(i, 1) = Sheets(3).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(3).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(3).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(3).Cells(j, x) Then .Cells(i, x).Interior.Color = vbRed
Next x
End If
p = 0
scadena = vbNullString
Next i
End With
End Sub
El problema es que cuando una de las dos hojas a comparar tiene muchos registros simplemente se bloquea. Son aproximadamente 13000 registros para comparar entre sí.
Solo necesito saber las diferencias. Aquí un ejemplo mas claro:
Hoja 1
Columna A(Valor Clave) Columna B
9999 10
8000 10
Hoja 2
Columna A(Valor Clave) Columna B
8000 10
9999 12
Compararía los valores en las dos hojas y resaltaría el 12 como la diferencia.
2 Respuestas
No especificas si es los valores son únicos en ambas hojas es decir que no hay datos repetidos así que bajo ese supuesto hice esta macro
la macro se tarda muy poco en 20000 filas es casi instantaneo.
Sub compara()
Set tabla = Hoja1.Range("a1").CurrentRegion
Set tabla2 = Hoja2.Range("a1").CurrentRegion
With tabla
filas = .Rows.Count
For i = 1 To filas
numero = .Cells(i, 1)
cantidad = .Cells(i, 2)
On Error Resume Next
fila = WorksheetFunction.Match(numero, tabla2.Columns(1), 0)
If Err.Number = 0 Then
cantidad2 = tabla2.Cells(fila, 2)
If cantidad <> cantidad2 Then tabla2.Rows(fila).Interior.ColorIndex = 4
End If
On Error GoTo 0
Next i
End With
Set tabla = Nothing: Set tabla2 = Nothing
End Sub
Hola
Probé la macro y no me ha funcionado.
Tengo dos hojas con 19 columnas y 12 registros cada una. Los registros son únicos en la primer columna de cada fila . Necesito comparar el valor de cada registro columna por columna para resaltar las diferencias y ver qué cambio.
Los registros no se repiten. Ejemplo en la primer hoja tengo 13000 registros con información en las 19 columnas y necesito esos 13000 compararlos con 13000 en otra hoja y ver si hubo cambio en una columna específica. Ejemplo la columna 10"J" es salario y cambió para el registro 9999 en la hoja 2 entonces resaltarlo.
Lo más sano es que subas un imagen o el archivo así platicado ninguna de las soluciones que te hemos planteado te va a servir y si te alguna lo hace se va a tardar un buen, por ejemplo no entiendo si quieres comparar la columna 1 de la hoja 1 con cada columna de la hoja2. Luego la columna 2 con cada columna de la hoja o bien columna1 con columna1, columna2 con columna2.
https://www.sendspace.com/file/ln45o2
Adjunto esta un ejemplo. Las columnas son las mismas pero los registros pueden repetirse o no, es decir, pueden variar de hoja a hoja, pueden haber registros nuevos en la hoja 2 que no esten en la hoja 1 y pueden haber registros de la hoja 1 que ya no estén en la 2. Necesito que compare la hoja 1 con la 2 y muestre que cambió de la primera respecto a la segunda para cada columna de cada registro, si se eliminaron registros, se agregaron registros o solo cambiaron los valores de algunas columnas para determinados registros.
El código que coloqué en la pregunta inicial funciona pero hasta 1000 registros cuando son más que estos se bloquea.
Gracias por la ayuda,
Se me olvido mencionar también que son 19 columnas las que necesito comparar para cada registro.
Este es el resultado de la macro, la macro buscara el numero de identificación de la tabla1 en la tabla2 de encontrarlo comparara el contenido de ambas filas y donde existan cambios los coloreara de verde, en caso de no existir el numero de identificación de la tabla1 en la tabla2 este sera ignorado y pasara al siguiente numero, la macro es dinámica si quitas o agregas registros esta trabajara con lo que quede
y esta es la macro
Sub COMPARAR()
Set tabla = Range("TABle1")
Set tabla2 = Range("TABLe2")
filas = tabla.Rows.Count
filas2 = tabla2.Rows.Count
col = tabla.Columns.Count
For i = 1 To filas
fila = tabla.Rows(i)
dato = tabla.Cells(i, 1)
On Error Resume Next
fila2 = WorksheetFunction.Match(dato, tabla2.Columns(1), 0)
If Err.Number > 0 Then GoTo siguiente
On Error GoTo 0
For j = 1 To col
dato3 = tabla.Cells(i, j)
dato2 = tabla2.Cells(fila2, j)
If dato3 <> dato2 Then tabla2.Cells(i, j).Interior.ColorIndex = 4
Next j
siguiente:
Next i
Set tabla = Nothing: Set tabla2 = Nothing
End Sub
Adapté una de las macros de la sección Ejemplos de mi sitio, creo que te servirá y de código más sencillo. Se recorre Hoja1 coloreando en Hoja2.
Sub coloreaDiferentes() 'en original= coloreaDuplicados
'x Elsamatilde
' trabajo desde hoja1 a partir de fila 2
[A2].Select
'recorro la tabla1 hasta encontrar 1 celda vacía que me indica el fin de rango
While ActiveCell <> ""
dato = ActiveCell.Value
'busco código en 2º tabla, col A
Set busco = Sheets(3).Range("A:A").Find(dato, LookIn:=xlValues, lookat:=xlWhole)
'si lo encontró compara valores en B
If Not busco Is Nothing Then
If ActiveCell.Offset(0, 1) <> busco.Offset(0, 1) Then
busco.Offset(0, 1).Interior.Color = RGB(220, 230, 240)
End If
End If
ActiveCell.Offset(1, 0).Select
'repito el bucle
Wend
MsgBox "Fin del proceso."
End Sub
Sdos y no olvides valorar las respuestas.
Elsa
PD) Todo lo que necesitas saber para manejar Bucles lo podrás encontrar aquí.
En primer lugar pido disculpas a James por intervenir pero cuando abrí esta consulta estaba aún sin respuestas ... luego me demoré un poco ;)
Se me ocurrió que quizás te sería de utilidad dejar un formato condicional, que te coloree las diferencias. Es otra opción posible.
En la tabla menor, selecciona el rango o la 1er celda de la col B y desde Formato Condicional opta por : Aplicar una fórmula. Tal como se observa en la siguiente imagen.
Aquí el formato aplicado es de fuente en rojo.
Si solo seleccionaste la primer celda luego copia formato al resto de la columna.
PD) Varios ejemplos más de Formato Condicional con fórmulas en el video 18 de mi canal.
Sdos!