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