动态比较行，逐个单元格，然后转到下一行并重复（大范围）

Question

我正在尝试比较两组大数据并突出显示彼此不匹配的单元格。如果某行的单元格不同，则将该行复制并粘贴到单独的 sheet。我还需要它是动态的，因为数据集可以更改列 and/or 行。

例如：要将 B2 与 E2、C2 与 F2 进行比较，请突出显示差异并将粘贴行复制到另一个 sheet。然后向下移动到下一行，比较 B3 和 E3，C3 和 F3 并继续循环直到完成。

目前，我有以下代码，但是它将第一个范围区域中的一个单元格与第二个范围区域中的一个单元格进行比较，然后它移动到第一个范围区域中的下一个单元格并重复。我需要它来分别比较每个单元格。

Sub Compare()

Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, I As Integer, J As Integer

Set rangeToUse = Selection
Cells.Interior.ColorIndex = 0
Cells.Borders.LineStyle = xlNone

If Selection.Areas.Count <= 1 Then
      MsgBox "Please select more than one area."
    Else
        rangeToUse.Interior.ColorIndex = 38
        For Each singleArea In rangeToUse.Areas
            singleArea.BorderAround ColorIndex:=1, Weight:=xlThin
        Next singleArea
        For I = 1 To rangeToUse.Areas.Count
            For J = I + 1 To rangeToUse.Areas.Count
                For Each cell1 In rangeToUse.Areas(I)
                    For Each cell2 In rangeToUse.Areas(J)
                        If cell1.Value <> cell2.Value Then
                            cell1.Interior.ColorIndex = 0
                            cell2.Interior.ColorIndex = 0
                        End If
                    Next cell2
                Next cell1
            Next J
        Next I
End If

End Sub

Answer 1

在我看来，您正在将第一个范围内的每个单元格与第二个范围内的每个单元格进行比较，我不相信这就是您想要的去做。我还假设您想比较 area(1) 和 area(2)，而不是 area(1) 和 area(1)..area(n)，然后是 area(2) 和 area(1)..area(n)。

Sub Compare()

Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range
Dim I As Integer, J As Integer

Set rangeToUse = Selection
Cells.Interior.ColorIndex = 0
Cells.Borders.LineStyle = xlNone

If Selection.Areas.Count <= 1 Then
      MsgBox "Please select more than one area."
    Else
        rangeToUse.Interior.ColorIndex = 38
        For Each singleArea In rangeToUse.Areas
            singleArea.BorderAround ColorIndex:=1, Weight:=xlThin
        Next singleArea
        'Areas.count - 1 will avoid trying to compare
        ' Area(count) to the non-existent area(count+1)
        For I = 1 To rangeToUse.Areas.Count - 1
            For Each cell1 In rangeToUse.Areas(I)
                'I+1 gets you the NEXT area
                set Cell2 = rangeToUse.areas(I+1).Cells(cell1.row, Cell1.Column)
                if cell1.value <> Cell2.value then
                    cell1.Interior.ColorIndex = 0
                    Cell2.Interior.ColorIndex = 0
                    Cell1.EntireRow.Copy Destination:=DestSheet.DestRow
                End If
            Next cell1
        Next I
End If

End Sub

这一行：
set Cell2 = rangeToUse.areas(I+1).Cells(cell1.row, Cell1.Column)
可能需要进行一些调整才能使偏移量正确，但我相信这会让您朝着正确的方向前进。我相信 cell1.Row 和 cell1.Column 会给你一个范围内的亲戚 row/column，但我不是 100% 确定。

动态比较行，逐个单元格，然后转到下一行并重复（大范围）

Dynamically compare row, cell by cell, then go to next row and repeat (Large Range)

excel

vba

compare

dynamic

excel-2010