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

I've a question similar to the one on the post VBA macro to compare two columns and color highlight cell differences.

我有一个类似于后VBA宏的问题来比较两列和颜色突出显示单元格差异。

I used it as reference point, but now I'm stuck for hours solving my case. Code included below, I'll explain my case first for better understanding and to be easier to follow.

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

Case: I've the following Worksheet before any manipulation. I'm comparing the columns "A:B" and "D:E", etc (from row 3 until the last used row). See the screenshot below for a better visualization (this is just part of the data).

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

Now I would like to see 2 actions performed:

现在我想看到2个动作：

1. Highlight the cells in A column and D column that are not part of the B and E column - I'll refer to these cells as errors
2. 突出显示A列和D列中不属于B和E列的单元格 - 我将这些单元格称为错误
3. Copy the value of the errors (highlighted cell (from A and D)) into the C and F column (this is the "Review column" - which is always 2 columns to the right in relation to the initial column)
4. 将错误的值（突出显示的单元格（从A和D））复制到C和F列（这是“查看列” - 相对于初始列，它始终是右侧的2列）

See the screenshot below for a better visualization

请参阅下面的屏幕截图以获得更好的可视

CODE:

码：

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

Problem:

问题：

1. I'm trying to highlight the error cells with dark red background. but this code is doing exactly the opposite (is highlighting the values that match).
2. 我正在尝试用深红色背景突出显示错误单元格。但是这段代码正好相反（突出显示匹配的值）。
3. How can I make the error value (the one that gets highlighted) appear in the the "check column".
4. 如何使错误值（突出显示的值）显示在“检查列”中。

I really appreciate any suggestion and support you can give to me

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

Thank you very much and have a nice day

非常感谢你，祝你有个愉快的一天

3 个解决方案

#1

I suggest to use the WorksheetFunction.Match Method instead of that second j loop. And use the Range.Offset Property to address the offset cell to copy the value.

我建议使用WorksheetFunction.Match方法而不是第二个j循环。并使用Range.Offset属性来寻址要复制值的偏移单元格。

Here is an example for the data shown in your screenshot.

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

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

#2

As mentioned in the comments, you need to check if the InStr function returns zero (see the MSDN page on InStr), not greater than zero. Note that using InStr will match partial matches too (if you have "a" in column A, that will match with any string in column B that contains "a"). If you want more exact matches use = or the Like keyword (in conjunction with something like the UCASE function to match across cases). However, the reason that alone will not work is that it does this if the A column cell is not equal to ALL of the column B cells. It checks against the first one, if it isn't equal to that it gets highlight, and on to the second entry in row A to repeat. You need an If-Else to do something if it does match, and you will need to check every entry (the exit for statement needs to go in the case where there IS a match). To copy your highlighted cells into column C, F, etc... you can offset two columns from your current A column when inside the inner If statement.

如注释中所述，您需要检查InStr函数是否返回零（请参阅InStr上的MSDN页面），不大于零。请注意，使用InStr也会匹配部分匹配（如果A列中有“a”，那么它将匹配B列中包含“a”的任何字符串）。如果你想要更精确的匹配使用=或Like关键字（结合类似UCASE函数的东西来匹配不同的情况）。但是，单独不起作用的原因是，如果A列单元格不等于所有列B单元格，则会执行此操作。它检查第一个，如果它不等于它突出显示，并检查到行A中的第二个条目重复。如果匹配，你需要一个If-Else做某事，你需要检查每个条目（语句的出口需要在匹配的情况下）。要将突出显示的单元格复制到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

Or using InStr:

或者使用InStr：

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

It would also be quicker to use a while statement instead of the for loops to keep going until a blank cell is encountered so that you don't keep checking blank cells.

使用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

#3

Another possibility; make a string of your arrMDCheckSheet-array (I changed the Instr function and added one line for third column, to keep your original code as much as it is)

另一种可能性创建一个arrMDCheckSheet数组的字符串（我更改了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