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