如何比较两个不同工作表上的两个不同列并突出显示差异?

时间:2015-07-20 20:46:13

标签: excel vba excel-vba

我希望能够比较两个工作表,如果ws1上的列H和ws2上的列F中的日期存在差异,则突出显示ws2上的单元格。我遇到的麻烦是它们是从两个不同的单元开始的两个不同的列(比较ws1上的H9 +和ws2上的F10 +)这没有给我任何错误,但似乎没有任何事情发生。以下是我到目前为止的情况:

Sub matchMe()
Dim wS As Worksheet, wT As Worksheet
Dim r1 As Range, r2 As Range
Dim cel1 As Range, cel2 As Range

Set wS = ThisWorkbook.Worksheets("Project Status Report L3")
Set wT = ThisWorkbook.Worksheets("Demand Mapping - Active")

With wS
    Set r1 = .Range("H9", .Cells(.Rows.Count, .Columns("R:R").Column).End(xlUp))
End With

With wT
    Set r2 = .Range("F10", .Cells(.Rows.Count, .Columns("G:G").Column).End(xlUp))
End With

On Error Resume Next
For Each cel1 In r1
    With Application
        Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in sheet2
        If Err = 0 Then
            If cel1.Offset(, 8) <> cel2.Offset(, 8) Then cel2.Interior.ColorIndex = 1  'if difference, color
        End If
        Err.Clear
    End With
Next cel1

End Sub

2 个答案:

答案 0 :(得分:1)

我在网上找到了这段代码,它应该做你需要的。只需将shtBefore和shtAfter设置为工作表名称即可。

Sub compareSheets(shtBefore As String, shtAfter As String)

Dim mycell As Range
Dim mydiffs As Integer

For Each mycell In ActiveWorkbook.Worksheets(shtAfter).UsedRange
    If Not mycell.Value = ActiveWorkbook.Worksheets(shtBefore).Cells(mycell.Row, mycell.Column).Value Then

        mycell.Interior.Color = vbYellow
        mydiffs = mydiffs + 1

    End If
Next

MsgBox mydiffs & " differences found", vbInformation

ActiveWorkbook.Sheets(shtAfter).Select

End Sub

答案 1 :(得分:0)

Sub comparison()
For i = 2 To 1000
For j = 2 To 1000
If Worksheets(Worksheet).Range("A" & i).Value = Worksheets(Worksheet).Range("L" & j).Value Then
Worksheets(worksheet).Range("N" & j).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

End If
Next j
Next i
End Sub