Question

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

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

enter image description here

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

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将为您提供范围内的相对行/列，但我并非100％确定。

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

1 个答案: