在Excel VBA中检查两个范围是否相等的最快方法

Question

假设您有两组数据，行数和列数相同。现在您想检查一组单元格中的数据是否等于另一组具有相同相对地址的单元格中的数据。如果对于一行的所有单元格都成立，则从两个集合中删除该行。如果数据集很大，逐个比较每个单元格的代码效率低下。请参考以下代码，其中两列数据恰好在同一工作表上并排放置，它们之间的列偏移量为300。

Dim RngOb As Range
Dim c As Range

Range("A1", "B1").Select
set RngOb = Range(Selection, Selection.End(xlDown))

For Each c In RngOb.Rows
    If c.Cells(1,1).Value = c.Offset(0, 300).Cells(1,1).Value Then
        If c.Cells(1,2).Value = c.Offset(0, 300).Cells(1,2).Value Then    
            c.EntireRow.Delete
        End If
    End If
Next

我的实际数据有100多列,每天的列数不同。我正在寻找一种聪明、快速的方法来处理大型数据集。非常感谢您的回答、反馈和批评:D

- steinbitur

---

如果数据像我的示例一样并排放置，列偏移量必须大于列数。 - steinbitur

@steinbitur 你测试的列之间是否有数据？每天列之间的偏移量是否相同？ - Ron Rosenfeld

其他一百列怎么办？ - Ron Rosenfeld

在这个例子中，每个数据集都有两列。它们之间有288个空列。如果数据集有120列，则它们之间将有180个空列。我正在寻找一种方法来完成这个任务，而不需要循环或逐个检查单元格。如果代码相应地进行修改，数据的位置并不重要。 - steinbitur

您可以使用@TimWilliams编写的这段代码来比较范围。 - Siddharth Rout

Answer 1

以下是比较两个同构区间中的两行的简单方法.............在这个例子中比较的是每个区间的第五行：

Sub RowCompare()
    Dim ary1() As Variant
    Dim Range1 As Range, Range2 As Range, rr1 As Range, rr2 As Range
    Set Range1 = Range("B9:F20")
    Set Range2 = Range("I16:M27")
    Set rr1 = Range1.Rows(5)
    Set rr2 = Range2.Rows(5)
    ary1 = Application.Transpose(Application.Transpose(rr1))
    ary2 = Application.Transpose(Application.Transpose(rr2))
    st1 = Join(ary1, ",")
    st2 = Join(ary2, ",")
    If st1 = st2 Then
        MsgBox "the same"
    Else
        MsgBox "different"
    End If
End Sub

如果您在单元格中嵌入了逗号，那么请在JOIN中选择另一个字符。

- Gary's Student

---

Gary，你的回答几乎和我提供的链接中Tim发布的答案一样 :) - Siddharth Rout

@SiddharthRout: 你参考的代码要紧凑得多。 - Gary's Student

确实，它回答了OP的问题，并且有详细的解释 :) 理想情况下，您应该将此问题标记为重复。但无论如何，我将决定留给您 :) - Siddharth Rout

Answer 2

如果我正确理解了您的问题，下面的代码应该允许您做您想做的事情。在代码中，您选择要处理的范围;每个数据集的第一列和每个数据集内的列数。

它假设只有两个数据集，正如您所写的那样，尽管可以扩展。如果没有其他数据在其中，还有自动确定数据集列的方法。

Option Explicit
Option Base 0
Sub RemoveDups()
    Dim I As Long, J As Long
    Dim rRng As Range
    Dim vRng As Variant, vRes() As Variant
    Dim bRng() As Boolean
    Dim aColumns, lColumns As Long
    Dim colRowsDelete As Collection

'vRng to include from first to last column to be tested
Set rRng = Range("f1", Cells(Rows.Count, "F").End(xlUp)).Resize(columnsize:=100)
vRng = rRng
ReDim bRng(1 To UBound(vRng))

'columns to be tested
'Specify First column of each data set
aColumns = Array(1, 13)

'num columns in each data set
lColumns = 3

For I = 1 To UBound(vRng)
    bRng(I) = vRng(I, aColumns(0)) = vRng(I, aColumns(1))
    For J = 1 To lColumns - 1
        bRng(I) = bRng(I) And (vRng(I, aColumns(0) + J) = vRng(I, aColumns(1) + J))
    Next J
Next I

'Rows to Delete
Set colRowsDelete = New Collection
For I = 1 To UBound(bRng)
    If bRng(I) = True Then colRowsDelete.Add Item:=I
Next I

'Delete the rows
If colRowsDelete.Count > 0 Then
Application.ScreenUpdating = False
    For I = colRowsDelete.Count To 1 Step -1
        rRng.Rows(colRowsDelete.Item(I)).EntireRow.Delete
    Next I
End If
Application.ScreenUpdating = True
End Sub

- Ron Rosenfeld