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

Answer 1

这是一种比较同构范围中两行的简单方法.............在这个例子中每个范围的第5行：

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

如果您在单元格中嵌入逗号，请在加入

中选择其他字符

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

检查excel vba中两个范围是否相等的最快方法

2 个答案: