Consolidar datos de dos hojas en una hoja nueva
Tengo dos hoja con datos, necesito compararlas y hacer un consolidado en una hoja nueva, pero no se como hacerlo.
Solicito ayuda urgente
2 respuestas
H o l a:
En un correo nuevo envíame tu archivo y me explicas con ejemplos lo que necesitas.
Te anexo la macro
Sub ConsolidarDatos()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
Set h1 = Sheets("PLANILLA ASISTENCIA")
Set h2 = Sheets("BIOMETRICO ASISTENCIA")
Set h3 = Sheets("CONSOLIDADO")
h3.Range("A4:AJ" & h3.Range("A" & Rows.Count).End(xlUp).Row + 4).ClearContents
'Compara 1 con 2 y actualiza 3
u = h1.Range("D" & Rows.Count).End(xlUp).Row
For i = 4 To u
Application.StatusBar = "Procesando Hoja1, Registro: " & i & " de " & u
'copia el registro de 1 a 3
u3 = h3.Range("D" & Rows.Count).End(xlUp).Row + 1
h1.Range("A" & i & ":AJ" & i).Copy h3.Range("A" & u3)
'
existe = False
Set r = h2.Columns("D") 'busca por id trabajador
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
fila = b.Row
'iguala columnas
For j = Columns("E").Column To Columns("AI").Column
If h2.Cells(b.Row, j) = 1 Then
h3.Cells(u3, j) = 1
End If
Next
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
Next
'
'Compara 2 con 1 y actualiza 3
u = h2.Range("D" & Rows.Count).End(xlUp).Row
For i = 4 To u
Application.StatusBar = "Procesando Hoja2, Registro: " & i & " de " & u
existe = False
Set r = h1.Columns("D") 'busca por ID trabajador
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
'copia el registro de 2 a 3
u3 = h3.Range("D" & Rows.Count).End(xlUp).Row + 1
h2.Range("A" & i & ":AJ" & i).Copy h3.Range("A" & u3)
End If
Next
'
u = h3.Range("D" & Rows.Count).End(xlUp).Row
With h3.Sort
.SortFields.Clear: .SortFields.Add Key:=h3.Range("A4:A" & u)
.SortFields.Add Key:=h3.Range("B4:B" & u)
.SortFields.Add Key:=h3.Range("D4:D" & u)
.SetRange h3.Range("A3:AJ" & 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
- Compartir respuesta
Si quieres comparar celda a celda puedes usar esto:
=SI(Hoja2!A1="";SI(Hoja3!A1="";"";Hoja3!A1);Hoja2!A1)
El problema lo tienes si hay datos en las dos celdas, puesto que la fórmula te devolverá el valor de la primera hoja en la que mira (Hoja2). Si siempre que se dé el caso ya te va bien que sea así, esto te sirve. Caso contrario habría que darle una vuelta según lo que quieras.
Si los datos están organizados de forma lógica como base de datos con registros que se pueden identificar con el valor de un campo tipo ID, entonces la cosa cambia. Ya respondí a un problema así hace unos días:
@¿Macro para realizar BuscarV dependiendo de los titulos?
La cuestión es que quiero comparar dos hojas que en teoría deberían tener los mismos registros, es decir, ser iguales, la cuestión es que una tiene mas registros que la otra. La idea es que compare las dos hojas 1 y 2, y en hoja 3 me copie lo de las dos hojas sin duplicados.
La macro que tengo me compara las dos hojas, primero compara la hoja 1 con la dos y en la hoja 1 me copia lo que tenia diferente con hoja2, luego compara la hoja 2 con la 1 y en la hoja 2 me copia lo que le faltaba de la hoja 1 quedando las dos hojas exactamente iguales.
Solo que ahora no puedo modificar las hojas 1 y 2, esas comparaciones necesito que me las arroje a hoja3 como consolidado.
No se si me hice entender.
No termino de entender. Por lo que dices comparas celda a celda primando los datos de la hoja 2 en caso que en ambas haya datos. Entonces la solución sería algo así:
=SI(Hoja2!A1="";SI(Hoja1!A1="";"";Hoja1!A1);Hoja2!A1)
Y arrastras hasta donde quieras.
La otra opción sería una macro.
Private Sub BtnIgualar_Click()
Application.ScreenUpdating = False
Application.StatusBar = False
Set h1 = Sheets("PLANILLA ASISTENCIA")
Set h2 = Sheets("BIOMETRICO ASISTENCIA")
'
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("B4:B" & u)
.SortFields.Add Key:=h1.Range("C4:C" & u)
.SortFields.Add Key:=h1.Range("D4:D" & u)
.SetRange h1.Range("A3: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
- Compartir respuesta
Gracias Dante, la verdad de que he mirado un poco el código y no me queda nada claro qué es lo que pretende... mis conocimientos son muy limitados aún. - víctor ibarz