Comparación de datos de dos hojas
Tengo estas dos tablas en hojas diferentes,
Necesito comparar las dos tablas teniendo en cuenta las columnas Proyecto, Contratista y Trabajador, luego que me compare las casillas que tienen 1, si en una tabla está marcada la casilla y en la otra no, que la marque en la que falta para que queden iguales y en caso de que el trabajador no exista en una de las dos tablas, lo ingrese para que las dos tablas queden exactamente iguales.
1 respuesta
Respuesta de Dante Amor
2
H o l a:
Te anexo la macro. Al final, las 2 hojas se ordenan por las columnas A, B y D
Sub IgualarTablas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
'Compara 1 con 2 y actualiza 2
u = h1.Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To u
Application.StatusBar = "Procesando Hoja1, Registro: " & i & " de " & u
existe = False
Set r = h2.Columns("D")
Set b = r.Find(h1.Cells(i, "D"), lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h2.Cells(b.Row, "A") = h1.Cells(i, "A") And _
h2.Cells(b.Row, "B") = h1.Cells(i, "B") Then
existe = True
'iguala columnas
For j = Columns("E").Column To Columns("AH").Column
If h1.Cells(i, j) <> h2.Cells(b.Row, j) Then
If h1.Cells(i, j) = 1 Then
h2.Cells(b.Row, j) = 1
Else
h1.Cells(i, j) = 1
End If
End If
Next
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
If existe = False Then
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Rows(i).Copy h2.Rows(u2)
End If
Next
'
'Compara 2 con 1 y actualiza 1
u = h2.Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To u
Application.StatusBar = "Procesando Hoja2, Registro: " & i & " de " & u
existe = False
Set r = h1.Columns("D")
Set b = r.Find(h2.Cells(i, "D"), lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h1.Cells(b.Row, "A") = h2.Cells(i, "A") And _
h1.Cells(b.Row, "B") = h2.Cells(i, "B") Then
existe = True
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
If existe = False Then
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Rows(i).Copy h1.Rows(u1)
End If
Next
'
u = h1.Range("D" & Rows.Count).End(xlUp).Row
With h1.Sort
.SortFields.Clear: .SortFields.Add Key:=h1.Range("A2:A" & u)
.SortFields.Add Key:=h1.Range("B2:B" & u)
.SortFields.Add Key:=h1.Range("D2:D" & u)
.SetRange h1.Range("A1:AI" & u): .Header = xlYes: .Apply
End With
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Tengo un inconveniente y es que las dos hojas no son iguales, la segunda hoja comienza desde la columna B, acomodé los datos pero me los deja corridos en algunas filas además de que me copia lo de la hoja 1 al final de los datos de la hoja 2 y viceversa, es decir que no los está igualando.
H o l a:
Tal vez no entendí cómo quieres que se igualen.
Envíame 2 archivos, cada archivo con lo siguiente:
- En el primer archivo, con las 2 hojas, me pones varios ejemplos reales de cómo está la información, antes de igualarse.
- En el segundo archivo, en las 2 hojas, me pones cómo quieres el resultado.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Adri Bautista” y el título de esta pregunta.
Hola.
Ya te envié los archivos al correo. Gracias.
Te anexo la macro actualizada con las columnas correctas.
Sub IgualarTablas2()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
Set h1 = Sheets("PLANILLA ASISTENCIA")
Set h2 = Sheets("BIOMETRICO ASISTENIA")
'
If h1.AutoFilterMode Then h1.AutoFilterMode = False
If h2.AutoFilterMode Then h2.AutoFilterMode = False
'Compara 1 con 2 y actualiza 2
u = h1.Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To u
Application.StatusBar = "Procesando Hoja1, Registro: " & i & " de " & u
existe = False
Set r = h2.Columns("C") 'nombre hoja2 "D"
Set b = r.Find(h1.Cells(i, "D"), lookat:=xlWhole) 'nombre hoja1 "E"
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h2.Cells(b.Row, "A") = h1.Cells(i, "B") And _
h2.Cells(b.Row, "B") = h1.Cells(i, "C") Then
existe = True
'iguala columnas
For j = Columns("G").Column To Columns("AJ").Column
If h1.Cells(i, j) <> h2.Cells(b.Row, j - 2) Then
If h1.Cells(i, j) = 1 Then
h2.Cells(b.Row, j - 2) = 1
Else
h1.Cells(i, j) = 1
End If
End If
Next
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
If existe = False Then
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("B" & i & ":E" & i).Copy h2.Range("A" & u2)
h1.Range("G" & i & ":AK" & i).Copy h2.Range("E" & u2)
End If
Next
'
'Compara 2 con 1 y actualiza 1
u = h2.Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To u
Application.StatusBar = "Procesando Hoja2, Registro: " & i & " de " & u
existe = False
Set r = h1.Columns("D") 'nombre hoj1
Set b = r.Find(h2.Cells(i, "C"), lookat:=xlWhole) 'nombre hoja2
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h1.Cells(b.Row, "B") = h2.Cells(i, "A") And _
h1.Cells(b.Row, "C") = h2.Cells(i, "B") Then
existe = True
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
If existe = False Then
u1 = h1.Range("B" & Rows.Count).End(xlUp).Row + 1
h2.Range("A" & i & ":D" & i).Copy h1.Range("B" & u1)
h2.Range("E" & i & ":AI" & i).Copy h1.Range("G" & u1)
End If
Next
'
u = h1.Range("D" & Rows.Count).End(xlUp).Row
With h1.Sort
.SortFields.Clear: .SortFields.Add Key:=h1.Range("B2:B" & u)
.SortFields.Add Key:=h1.Range("C2:C" & u)
.SortFields.Add Key:=h1.Range("D2:D" & u)
.SetRange h1.Range("A1:AK" & u): .Header = xlYes: .Apply
End With
'
u = h2.Range("D" & Rows.Count).End(xlUp).Row
With h2.Sort
.SortFields.Clear: .SortFields.Add Key:=h1.Range("A2:A" & u)
.SortFields.Add Key:=h1.Range("B2:B" & u)
.SortFields.Add Key:=h1.Range("C2:C" & u)
.SetRange h1.Range("A1:AI" & u): .Header = xlYes: .Apply
End With
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Muy bueno - Adriel Ortiz Mangia