比较 2 个工作表中的所有单元格

Question

我需要能够比较 2 个工作表中的每个单元格，但数据不会总是在同一行，因为新数据会不断添加和导出。

两张纸上的范围都相当大，所以现在我将其限制为 A1:AS150。任何找不到匹配项的实例我都想突出显示该单元格。

我找到了这个，它看起来与我需要的很接近，但不起作用（显然，我在我的工作示例中添加了 Else 代码）。

Sub test()

Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long

strRangeToCheck = "A1:AS150"
' If you know the data will only be in a smaller range, reduce the size of the ranges above.
Debug.Print Now
varSheetA = Worksheets("Sheet1").Range(strRangeToCheck)
varSheetB = Worksheets("Sheet2").Range(strRangeToCheck) ' or whatever your other sheet is.
Debug.Print Now

For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
        If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
            ' Cells are identical.
            ' Do nothing.
        Else
            ' Cells are different.
            ' Code goes here for whatever it is you want to do.
        End If
    Next iCol
Next iRow

要回答“狐火和烧伤和烧伤”问题： 检查： Sheet1.Cell$.Value 是否存在于 sheet2 中，但适用于两个工作表范围内的每个单元格。

表 1

A	B	C
Paul	999	ABC111
John	888	ABC222
Harry	777	ABC333
Tom	666	ABC444

表 2

A	B	C
Tom	666	ABC444
John	888	ABC222
Harry	777	ABC333

所以在这些例子中：

在工作表 2 中搜索 Sheet1.A1，如果 = 匹配，则无其他内容，否则将突出显示红色。然后是 A2、A3 等，然后是 B1、B2 等，然后是 C1、C2 等……你明白了要点。

Answer 1

您在您的 VBA 代码中提到需要做一些事情，但在您的示例中，您只是表示将突出显示一个单元格。

Excel 的条件格式功能已经涵盖了这一点。您可以对公式进行条件格式设置（在您的情况下，您可能会使用 Match() 函数）。

我建议您开始使用=Match() 公式，以了解其工作原理（您可以使用=MATCH(A1,$B$1:$B$2,0) 作为示例，美元符号用于指示查找值不会更改） ，在不同的工作表上执行此操作，然后尝试使条件格式正常工作，首先基本上然后根据您的公式。

Answer 2

Sub test()
Dim varSheetA As Worksheet
Dim varSheetB As Worksheet
Dim i As Long
Dim LR As Long

Set varSheetA = ThisWorkbook.Worksheets("Sheet1")
Set varSheetB = ThisWorkbook.Worksheets("Sheet2")

LR = varSheetA.Range("A" & varSheetA.Rows.Count).End(xlUp).Row

For i = 1 To LR 'we start at first row of sheet 1
    If Application.WorksheetFunction.CountIf(varSheetB.Range("A:A"), varSheetA.Range("A" & i).Value) = 0 Then varSheetA.Range("A" & i).Interior.Color = vbRed
Next i

'clean variables

Set varSheetA = Nothing
Set varSheetB = Nothing

End Sub

代码将计算工作表 1 的 A 列中的每个单元格值，并检查它是否存在于工作表 2 的 A 列中的某个位置。如果不存在，则以红色突出显示。

使用您发布的数据示例执行代码后的输出：

更新“：我制作了一个假数据集。注意行Captain America。两张表中A和C列的值相同，但B列不同

Sub test()
Dim varSheetA As Worksheet
Dim varSheetB As Worksheet
Dim i As Long
Dim LR As Long
Dim MyPos As Long

Set varSheetA = ThisWorkbook.Worksheets("Sheet1")
Set varSheetB = ThisWorkbook.Worksheets("Sheet2")

LR = varSheetA.Range("A" & varSheetA.Rows.Count).End(xlUp).Row

For i = 1 To LR 'we start at first row of sheet 1
    If Application.WorksheetFunction.CountIf(varSheetB.Range("C:C"), varSheetA.Range("C" & i).Value) > 0 Then
        'Match found on Column C. Check A and B
        MyPos = Application.WorksheetFunction.Match(varSheetA.Range("C" & i).Value, varSheetB.Range("C:C"), 0)
        If varSheetA.Range("A" & i).Value <> varSheetB.Range("A" & MyPost.Value Then varSheetA.Range("A" & i).Interior.Color = vbRed
        If varSheetA.Range("B" & i).Value <> varSheetB.Range("B" & MyPos).Value Then varSheetA.Range("B" & i).Interior.Color = vbRed
    End If
Next i

'clean variables

Set varSheetA = Nothing
Set varSheetB = Nothing

End Sub

输出：

那个单元格因为不同而被高亮显示。

请注意，此代码仅在 C 列中的所有值都唯一时才有效。

Answer 3

这是我的代码：

Option Explicit

Private Const SHEET_1           As String = "Sheet1"
Private Const SHEET_2           As String = "Sheet2"
Private Const FIRST_CELL        As String = "A1"

Private Const MAX_ROWS          As Long = 1048576
Private Const MAX_COLUMNS       As Long = 16384

Private varSheetA               As Worksheet
Private varSheetB               As Worksheet

Private last_row                As Long
Private last_column             As Long
Private sheet1_row              As Long
Private sheet1_column           As Long
Private sheet2_row              As Long

Private row_match               As Boolean


Public Sub CompareTables()

    Set varSheetA = ThisWorkbook.Worksheets(SHEET_1)
    Set varSheetB = ThisWorkbook.Worksheets(SHEET_2)

    'Gets the real Table size
    For sheet1_row = 1 To MAX_ROWS - 1
    
        If varSheetA.Range(FIRST_CELL).Offset(sheet1_row, 0).Value = vbNullString _
                And varSheetB.Range(FIRST_CELL).Offset(sheet1_row, 0).Value = vbNullString Then
        
            last_row = sheet1_row
            Exit For
        
        End If
    
    Next
    For sheet1_column = 1 To MAX_ROWS - 1
    
        If varSheetA.Range(FIRST_CELL).Offset(0, sheet1_column).Value = vbNullString _
                And varSheetB.Range(FIRST_CELL).Offset(0, sheet1_column).Value = vbNullString Then
        
            last_column = sheet1_column
            Exit For
        
        End If
    
    Next
    
    'Sets color RED by default on both Tables
    Call SetTextRed(varSheetA.Range(FIRST_CELL).Resize(last_row, last_column))
    Call SetTextRed(varSheetB.Range(FIRST_CELL).Resize(last_row, last_column))

    'Sweeps all existing ROWS on Sheet1
    For sheet1_row = 1 To last_row
    
        'Sweeps all existing ROWS on Sheet2
        For sheet2_row = 1 To last_row
        
            row_match = True
        
            'Sweeps all existing COLUMNS on Sheet1 and Sheet2
            For sheet1_column = 1 To last_column
            
                If varSheetA.Range(FIRST_CELL).Offset(sheet1_row - 1, sheet1_column - 1).Value _
                        <> varSheetB.Range(FIRST_CELL).Offset(sheet2_row - 1, sheet1_column - 1).Value Then
                
                    row_match = False
                    Exit For
                End If
            Next
            
            If row_match Then Exit For 'Found and entire match, no need to search more
            
        Next
        
        'Formats as Grren whenever is a Match
        If row_match Then
        
            Call SetTextGreen(varSheetA.Range(FIRST_CELL).Offset(sheet1_row - 1, 0).Resize(1, last_column))
            Call SetTextGreen(varSheetB.Range(FIRST_CELL).Offset(sheet2_row - 1, 0).Resize(1, last_column))
        
        End If
        
    Next

End Sub


'Sub Function that sets entire row text as RED
Private Sub SetTextRed(ByVal entireRow As Range)

    With entireRow.Font
        .Color = RGB(255, 0, 0)
        .TintAndShade = 0
    End With

End Sub


'Sub Function that sets entire row text as GREEN
Private Sub SetTextGreen(ByVal entireRow As Range)

    With entireRow.Font
        .Color = RGB(0, 255, 0)
        .TintAndShade = 0
    End With

End Sub