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 Respuesta
Respuesta de William Kennedy
1
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
