Macro para Comparar dos tablas de datos

Quisiera ayuda para crear una macro que me compare dos criterios de una tabla con otros dos criterios de otra tabla, que coloree de amarillo los que coinciden y adicionalmente que anote una fecha a los que coinciden.

Por ejemplo:

Tengo la primera tabla en las columnas A & B, y la segunda tabla en las columnas E & F. Si el valor de A coincide con el valor de E, siempre y cuando coincida el valor de B con el valor de F, que coloree de amarillo dichas celdas que coinciden y que coloque la fecha 01/05/2015 en la celda G de las celdas que coincidan.

1

1 Respuesta

14.925 pts. Si estas tratando siempre de ser normal, nunca sabrás...
Private Sub Matchs()
Dim RS As String
Dim LBV, RSV, RSVr, LBVr As Double
Dim RSR, LBR As Range
'Cadena de Texto que almacena nombre del nuevo Refund Summary
RS = Workbooks("LogBook.xlsm").Sheets(2).Range("F21").Value
'Row # for Refunds Summary
i = 3
'Row # for LogBook
j = 1
    Do While Workbooks("LogBook.xlsm").Sheets(4).Cells(j, 1) And Workbooks(RS).Sheets(1).Cells(i, 1) <> ""
    'While Workbooks("LogBook.xlsm").Worksheets(4).Cells(j, 1) Or Workbooks(RS).Worksheets(1).Cells(i, 1) <> ""
    'Values to Search for
    RSV = Workbooks(RS).Sheets(1).Cells(i, 1).Value
    LBV = Workbooks("LogBook.xlsm").Sheets(4).Cells(j, 1).Value
    'Values Receive
    RSVr = Workbooks(RS).Sheets(1).Cells(i, 3).Value
    LBVr = Workbooks("LogBook.xlsm").Sheets(4).Cells(j, 3).Value
    'Ranges
    Set RSR = Workbooks(RS).Sheets(1).Range("A3:B1000")
    Set LBR = Workbooks("LogBook.xlsm").Sheets(4).Range("A1:B1000")
        On Error Resume Next
            Workbooks("LogBook.xlsm").Sheets(4).Cells(j, 3).Value = Application.WorksheetFunction.VLookup(LBV, RSR, 2, 0) * -1
                Workbooks(RS).Sheets(1).Cells(i, 3).Value = Application.WorksheetFunction.VLookup(RSV, LBR, 2, 0) * -1
                    If Workbooks("LogBook.xlsm").Sheets(4).Cells(j, 2) = Workbooks("LogBook.xlsm").Sheets(4).Cells(j, 3) Then
                        Workbooks("LogBook.xlsm").Sheets(4).Cells(j, 3) = Format(Now - 1, "MM/DD/YYYY")
                    Else:
                        Workbooks("LogBook.xlsm").Sheets(4).Cells(j, 3) = ""
                    End If
                    If Workbooks(RS).Sheets(1).Cells(i, 2) = Workbooks(RS).Sheets(1).Cells(i, 3) Then
                        Workbooks(RS).Sheets(1).Cells(i, 3) = Format(Now - 1, "MM/DD/YYYY")
                    Else:
                        Workbooks(RS).Sheets(1).Cells(i, 3) = ""
                    End If
                i = i + 1
            j = j + 1
    Loop
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas