VBA比较2个数组循环>>突出显示并将差异复制到第三列

Question

我有一个类似于VBA macro to compare two columns and color highlight cell differences 帖子中的问题。

我用它作为参考点，但现在我被困了好几个小时来解决我的问题。 代码包含在下面，我将首先解释我的案例以便更好地理解和更容易理解。

案例： 在进行任何操作之前，我有以下工作表。我正在比较列“A:B”和“D:E”等（从第 3 行到最后使用的行）。请参阅下面的屏幕截图以获得更好的可视化效果（这只是数据的一部分）。

现在我想查看执行的 2 个操作：

1. 突出显示 A 列和 D 列中不属于 B 列和 E 列的单元格 - 我将这些单元格称为错误
2. 将错误值（突出显示的单元格（来自 A 和 D））复制到 C 和 F 列（这是“审查列” - 相对于初始列，它始终是右侧的 2 列）

查看下面的屏幕截图以获得更好的可视化效果

代码：

Sub compare_cols()

    Dim Report As Worksheet
    Dim i As Integer, j As Integer
    Dim lastRow As Integer

    Set Report = Excel.Worksheets("Check_Sheet")

    lastRow = 80

    arrInputCheckSheet= Array("A", "D", "G", "J", "M", "P", "S", "V", "Y") 'I will use these columns to compare against the next array
    arrMDCheckSheet = Array("B", "E", "H", "K", "N", "Q", "T", "W", "Z") 'I will use these columns as reference 


    Application.ScreenUpdating = False

    For a = LBound(arrInputCheckSheet) To UBound(arrInputCheckSheet)
        For i = 3 To lastRow
            For j = 3 To lastRow
                If Report.Cells(i, arrInputCheckSheet(a)).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                    If InStr(1, Report.Cells(j, arrMDCheckSheet(a)).Value, Report.Cells(i, arrInputCheckSheet(a)).Value, vbTextCompare) > 0 Then 
                        Report.Cells(i, arrInputCheckSheet(a)).Interior.Color = RGB(156, 0, 6) 'Dark red background
                        Report.Cells(i, arrInputCheckSheet(a)).Font.Color = RGB(255, 199, 206) 'Light red font color
                        Exit For
                    Else
                  End If
                End If
            Next j
        Next i
    Next a

Application.ScreenUpdating = True

End Sub

问题：

1. 我正在尝试用深红色背景突出显示错误单元格。但这段代码的作用恰恰相反（突出显示匹配的值）。
2. 如何使错误值（突出显示的那个）出现在“检查列”中。

非常感谢您给我的任何建议和支持

非常感谢，祝你有美好的一天

Answer 1

我建议使用 WorksheetFunction.Match Method 而不是第二个 j 循环。并使用Range.Offset Property 寻址偏移单元格以复制值。

以下是屏幕截图中显示的数据示例。

Option Explicit

Sub compare_cols()
    Dim Report As Worksheet
    Set Report = Excel.Worksheets("Check_Sheet")

    Dim lastRow As Long
    lastRow = 10

    Dim arrInputCheckSheet As Variant
    arrInputCheckSheet = Array("A", "D") 'I will use these columns to compare against the next array

    Dim arrMDCheckSheet As Variant
    arrMDCheckSheet = Array("B", "E") 'I will use these columns as reference

    Dim j As Long
    j = 13 'start at row 13

    'Application.ScreenUpdating = False 'disable this during debug
    Const firstRow As Long = 3
    Dim a As Long
    For a = LBound(arrInputCheckSheet) To UBound(arrInputCheckSheet)
        Dim i As Long
        For i = firstRow To lastRow
            Dim MatchRow As Long
            If Report.Cells(i, arrInputCheckSheet(a)).Value <> vbNullString Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.

                On Error Resume Next 'match throws an error if nothing matched
                MatchRow = 0
                MatchRow = Application.WorksheetFunction.Match(Report.Cells(i, arrInputCheckSheet(a)).Value, Report.Range(Cells(firstRow, arrMDCheckSheet(a)), Cells(lastRow, arrMDCheckSheet(a))), 0)
                On Error GoTo 0 're-activate error reporting

                If MatchRow = 0 Then
                    'no match
                    With Report.Cells(i, arrInputCheckSheet(a))
                        .Interior.Color = RGB(156, 0, 6) 'Dark red background
                        .Font.Color = RGB(255, 199, 206) 'Light red font color

                        .Offset(0, 2).Value = .Value 'copy value

                        'copy to different sheet
                        Sheets("Check_Sheet").Cells(j, arrControlSheet(a)) = .Value
                        j = j + 1 'increase row counter after each copy
                    End With
                End If
            End If

        Next i
    Next a

    'Application.ScreenUpdating = True
End Sub

Answer 2

如 cmets 中所述，您需要检查 InStr 函数是否返回零（参见MSDN page on InStr），不大于零。请注意，使用 InStr 也会匹配部分匹配项（如果 A 列中有“a”，则它将与 B 列中包含“a”的任何字符串匹配）。如果您想要更精确的匹配，请使用 = 或 Like 关键字（结合 UCASE 之类的函数来匹配不同的案例）。但是，单独不起作用的原因是，如果 A 列单元格不等于所有 B 列单元格，它会执行此操作。它检查第一个，如果它不等于它被突出显示，然后到 A 行中的第二个条目重复。如果匹配，您需要一个 If-Else 来执行某些操作，并且您需要检查每个条目（如果存在匹配，则需要执行 exit for 语句）。要将突出显示的单元格复制到列 C、F 等中......您可以在内部 If 语句中从当前 A 列偏移两列。

If UCase(Report.Cells(j, arrMDCheckSheet(a)).Value) Like UCase(Report.Cells(i, arrInputCheckSheet(a)).Value) Then
    Report.Cells(i, arrInputCheckSheet(a)).ClearFormatting
    Exit For
Else
    Report.Cells(i, arrInputCheckSheet(a)).Interior.Color = RGB(156, 0, 6) 'Dark red background
    Report.Cells(i, arrInputCheckSheet(a)).Font.Color = RGB(255, 199, 206) 'Light red font color
    Report.Cells(i, arrInputCheckSheet(a)).Offset(0,2).Value = Report.Cells(i, arrInputCheckSheet(a)).Value  ' This copies to the 3rd column
End If

或使用 InStr：

If InStr(1,Report.Cells(j, arrMDCheckSheet(a)).Value,Report.Cells(i, arrInputCheckSheet(a)).Value) = 0 Then

使用 while 语句而不是 for 循环继续运行直到遇到空白单元格也会更快，这样您就不会继续检查空白单元格。

i = 3
Do While Report.Cells(i, arrInputCheckSheet(a)).Value <> ""
    j = 3
    Do While Report.Cells(j, arrMDCheckSheet(a)).Value <> ""
        ' this would be the if statements, use exit do instead of exit for
        j = j + 1
    Loop
    i = i + 1
Loop

Answer 3

另一种可能性；制作你的 arrMDCheckSheet-array 的字符串 （我更改了 Instr 函数并为第三列添加了一行，以保留您的原始代码）

    For a = LBound(arrInputCheckSheet) To UBound(arrInputCheckSheet)
    For i = 3 To lastRow
        For j = 3 To lastRow
            If Report.Cells(i, arrInputCheckSheet(a)).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                If InStr(1, Join(Application.Transpose(Report.Range(Cells(3, arrMDCheckSheet(a)), Cells(lastRow, arrMDCheckSheet(a)))), "|"), Report.Cells(i, arrInputCheckSheet(a)).Value, vbTextCompare) = 0 Then
                    Report.Cells(i, arrInputCheckSheet(a)).Interior.Color = RGB(156, 0, 6) 'Dark red background
                    Report.Cells(i, arrInputCheckSheet(a)).Font.Color = RGB(255, 199, 206) 'Light red font color
                    Report.Cells(i, arrInputCheckSheet(a)).Offset(, 2) = Report.Cells(i, arrInputCheckSheet(a)) 'added
                    Exit For
                Else
              End If
            End If
        Next j
    Next i
Next a