найти недостающее значение, которое присутствует в листе 1, но отсутствует в листе 2 - PullRequest
0 голосов
/ 04 февраля 2019

Я написал пример кода, который сравнивает два листа и выделяет разные, если какое-либо значение в sheet1 для col1 не найдено в sheet2 для col2

Я хочу расширить этот код на весь лист.Таким образом, любое значение, которое отсутствует на листе 2, будет выделено на листе 1.

Как я могу это сделать?Я пытался увеличить диапазон на 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 голосов
/ 04 февраля 2019

Попробуйте это:

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
0 голосов
/ 04 февраля 2019
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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...