逐列比较两个Excel工作表

时间:2019-02-07 21:15:06

标签: excel vba

Sub CompareAndHighlight()

Dim xRange As Range, yRange As Range
Dim xCell As Range, yCell As Range
Dim Found As Range

Dim wsX As Worksheet: Set wsX = ThisWorkbook.Sheets("Sheet1")
Dim wsY As Worksheet: Set wsY = ThisWorkbook.Sheets("Sheet2")

LR1 = wsX.Range("A" & wsX.Rows.Count).End(xlUp).Row
LR2 = wsY.Range("A" & wsY.Rows.Count).End(xlUp).Row

Set xRange = wsX.Range("A1:A" & LR1)
Set yRange = wsY.Range("A1:A" & LR2)

For Each xCell In xRange

    Set Found = yRange.Find(xCell.Value)

    If Found Is Nothing Then
        xCell.Interior.Color = RGB(255, 0, 0)
    End If

    Set Found = Nothing

Next xCell

End Sub

我使用上面的代码比较两个Excel工作表。我只在“ A”列之间做比较。

我想做的是依次比较其他列,例如将“ B”与“ b”进一步比较,将“ c”与“ c”进一步比较。

如何通过更改代码来做到这一点。

2 个答案:

答案 0 :(得分:1)

我喜欢使用sheet.cells()目标,因此您可以轻松地使用整数来调出行和列

Sub CompareAndHighlight()

Dim xRange, yRange, xCell, yCell, Found As Range

Dim i, LR1, LR2 As Integer

Dim wsX As Worksheet: Set wsX = ThisWorkbook.Sheets("Sheet1")
Dim wsY As Worksheet: Set wsY = ThisWorkbook.Sheets("Sheet2")

For i = 1 To 3 'Set to the number of the last column you want to run the comparison 

    LR1 = wsX.Cells(wsX.Rows.Count, i).End(xlUp).Row
    LR2 = wsY.Cells(wsY.Rows.Count, i).End(xlUp).Row

    Set xRange = wsX.Range(wsX.Cells(1, i), wsX.Cells(LR1, i))
    Set yRange = wsY.Range(wsY.Cells(1, i), wsY.Cells(LR2, i))

    For Each xCell In xRange

        Set Found = yRange.Find(xCell.Value)

        If Found Is Nothing Then
            xCell.Interior.Color = RGB(255, 0, 0)
        End If

        Set Found = Nothing

    Next xCell
Next i

End Sub

答案 1 :(得分:0)

根据需要进行修改,然后尝试:

Option Explicit

Sub test()

    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rngToSearch As Range, FindPosition As Range
    Dim Lastrow1 As Long, Lastrow2 As Long, ColumnToSearch As Long, i As Long, y As Long
    Dim strToSearch As String

    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    Lastrow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    Lastrow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

    For i = 1 To Lastrow1

        For y = 1 To 3

            strToSearch = ws1.Cells(i, y).Value

            If y = 1 Then
                ColumnToSearch = 1
            ElseIf y = 2 Then
                ColumnToSearch = 2
            ElseIf y = 3 Then
                ColumnToSearch = 3
            End If

            Set rngToSearch = ws2.Range(ws2.Cells(1, ColumnToSearch), ws2.Cells(Lastrow2, ColumnToSearch))

            Set FindPosition = rngToSearch.Find(strToSearch)

            If FindPosition Is Nothing Then
                ws1.Cells(i, y).Interior.Color = RGB(255, 0, 0)
            End If

        Next y

    Next i

End Sub