Macro que compare los datos de 2 hojas de excel según 2 criterios
Tengo en un libro de excel habilitado para macros las hojas: "Formulado" y "Comprado"
En la hoja "Formulado" columna "A" desde la fila 1 en adelante tengo Numero ID organizados de Menor a Mayor de arriba hacia abajo y en la columna "B" desde la fila 1 en adelante tengo fechas en formato "dd-mmm-yy" sin ningún orden.
En la hoja "Comprado" tengo la misma organización, Columna "A" desde la fila 1 en adelante los números ID organizados de menor a mayor y en la columna "B" desde la fila 1 en adelante las fechas sin ningún orden.
Necesito una macro que haga lo siguiente:
Que busque cada ID de la columna "A" de la hoja "Formulado" desde la fila 1 en adelante, en la columna "A" de la hoja "Comprado" y si lo encuentre, analice entonces si la fecha registrada en la columna "B" de la hoja "Formulado" para ese ID es más antigua o igual a la resgistrada para ese mismo ID en la hoja "Comprado". Si se cumple esa condición entonces se debe eliminar la fila en la hoja "Formulado" del dato ID buscado.
En caso de que no se cumpla la condición, entonces todo queda igual y la macro continua con el siguiente ID de arriba hacia abajo para ser analizado y así sucesivamente hasta terminar de analizar los todos los datos de la columna "A" de la hoja formulado.
Sin son únicos en ambas hojas, entonces prueba la siguiente:
Sub Comparar_Datos()
Dim a As Variant, b As Variant, c As Variant
Dim dic As Object, rng As Range, sh As Worksheet
Dim i As Long, lr As Long
'
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
Set sh = Sheets("Formulado")
lr = sh.Range("A" & Rows.Count).End(3).Row
Set rng = sh.Range("A" & lr + 1)
a = sh.Range("A1:B" & lr).Value2
'
b = Sheets("Comprado").Range("A1:B" & Sheets("Comprado").Range("A" & Rows.Count).End(3).Row).Value2
For i = 1 To UBound(b, 1)
dic(b(i, 1)) = b(i, 2)
Next
For i = 1 To UBound(a, 1)
If dic.exists(a(i, 1)) And a(i, 2) <= dic(a(i, 1)) Then
Set rng = Union(rng, sh.Range("A" & i))
End If
Next
rng.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
