查找表1中存在但表2中不存在的缺失值

时间:2019-02-04 00:34:03

标签: excel vba

我编写了一个示例代码,用于比较两张纸,如果在col1的sheet1中找不到col2的任何值,则突出显示不同的地方

我想将此代码扩展到整个工作表。这样,工作表1中会突出显示工作表2中不存在的任何值。

我该怎么做?我试图通过A:Z来增加射程,但这给了我错误

Sub CompareAndHighlight()

Dim rng1 As Range, rng2 As Range, i As Integer, j As Integer
Dim isMatch As Boolean

For i = 2 To Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    isMatch = False
    Set rng1 = Sheets("Sheet1").Range("A" & i)
    For j = 1 To Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
        Set rng2 = Sheets("Sheet2").Range("A:B" & j)
        If StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0 Then
            isMatch = True
            Exit For
        End If
        Set rng2 = Nothing
    Next j

    If Not isMatch Then
        rng1.Interior.Color = RGB(255, 0, 0)
    End If
    Set rng1 = Nothing
Next i

End Sub

2 个答案:

答案 0 :(得分:0)

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("B" & wsY.Rows.Count).End(xlUp).Row

Set xRange = wsX.Range("A1:A" & LR1)
Set yRange = wsY.Range("B1:B" & 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

答案 1 :(得分:0)

尝试一下:

Sub CompareAndHighlight()

    ' Declare object variables
    Dim originalRange As Range
    Dim compareToSheet As Worksheet
    Dim cellRange As Range

    ' Declare other variables
    Dim originalSheetName As String
    Dim compareSheetName As String

    ' >>> Customize
    originalSheetName = "Sheet1"
    compareSheetName = "Sheet2"

    ' Initiate objects
    Set originalRange = ThisWorkbook.Worksheets(originalSheetName).UsedRange
    Set compareToSheet = ThisWorkbook.Worksheets(compareSheetName)


    ' Loop through used cells in first sheet
    For Each cellRange In originalRange

        If StrComp(cellRange.Value, compareToSheet.Range(cellRange.Address).Value, vbTextCompare) <> 0 Then
            cellRange.Interior.Color = RGB(255, 0, 0)
        End If

    Next

End Sub