Macro para diferencia en datos
En base a la pregunta anterior, esto es lo que necesito.
Los datos de las hojas BASE_ANTERIOR y BASE_ACTUAL son rangos de celdas (no tablas). La idea es que la macro evalúe ambas hojas con sus datos y muestre los resultados de la hoja RESULTADO, según lo que dice casa cuadro (nuevos, eliminados y modificados).
Los ejemplos serian:
La base del mes anterior:
La base del mes actual
La hoja de resultados:
El ideal es que los cuadros en resultado partan según el de arriba, es decir, que no sean estáticos ya que, por ejemplo, en un caso puedo tener solo un NUEVO pero al mes siguiente puedo tener 20, por lo que, si el cuadro ELIMINADOS parte siempre donde mismo, borrara los datos de arriba (mismo caso para los MODIFICADOS).
1 Respuesta
Te anexo la macro
Sub Comparar_Hojas()
'Por Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("BASE_ACTUAL")
Set h2 = Sheets("BASE_ANTERIOR")
Set h3 = Sheets("RESULTADOS")
'
h3.Rows("2:" & Rows.Count).Clear
For i = 2 To h1.Range("C" & Rows.Count).End(xlUp).Row
Set b = h2.Columns("C").Find(h1.Cells(i, "C").Value, LookAt:=xlWhole, LookIn:=xlValues)
If Not b Is Nothing Then
'Buscar diferencias
dif = ""
For j = 1 To Columns("I").Column
If h1.Cells(i, j).Value <> h2.Cells(b.Row, j).Value Then
dif = dif & "," & j
End If
Next
If dif <> "" Then
dif = Mid(dif, 2)
Call Poner_Registro(h3, i, 21, h1, dif)
Call Poner_Registro(h3, b.Row, 21, h2, dif)
End If
Else
Call Poner_Registro(h3, i, 1, h1)
End If
Next
'
For i = 2 To h2.Range("C" & Rows.Count).End(xlUp).Row
Set b = h1.Columns("C").Find(h2.Cells(i, "C").Value, LookAt:=xlWhole)
If b Is Nothing Then
Call Poner_Registro(h3, i, 11, h2)
End If
Next
'
Application.ScreenUpdating = True
Application.CutCopyMode = True
MsgBox "Fin"
End Sub
'
Sub Poner_Registro(h3, i, col, hoja, Optional dif)
'Por Dante Amor
fila = h3.Cells(Rows.Count, col).End(xlUp).Row + 1
hoja.Range("A" & i & ":I" & i).Copy
h3.Cells(fila, col).PasteSpecial xlValues
If col = 21 Then
h3.Cells(fila, col + 9).Value = hoja.Name
cols = Split(dif, ",")
For k = LBound(cols) To UBound(cols)
ncol = Val(cols(k))
h3.Cells(fila, ncol + 20).Interior.ColorIndex = 6
Next
End If
End SubEn la hoja "Resultados" debes poner las columnas de esta forma:
[sal u dos. No olvides valorar la respuesta.
Buena! Solo tengo un problema... En la parte de diferencias, el ideal es que en estas, no se contemple la primera columna para diferenciar (numero) ya que no siempre estarán en el mismo orden los datos.
Saludos y gracias
Cambia el 1 en esta línea
For j = 1 To Columns("I").ColumnPor un 2:
For j = 2 To Columns("I").Column[sal u dos. No olvides valorar la respuesta.
