【问题标题】:Fastest way to check if two ranges are equal in excel vba [duplicate]在excel vba中检查两个范围是否相等的最快方法[重复]
【发布时间】:2014-03-09 02:20:45
【问题描述】:

假设您有两组数据,并且行数和列数相同。现在您要检查一组中单元格中的数据是否等于另一组中具有相同相对地址的单元格中的数据。如果对于一行的所有单元格都是如此,则从两组中删除该行。我可以通过比较每个单元格来非常轻松地编写代码,这对大型数据集不利。有关两列的代码,请参见下面的代码,其中两组数据恰好并排在同一张工作表中,它们之间的列偏移量为 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

【问题讨论】:

  • 我会使用公式=AND(A1=L1,B1=M1) 添加临时列,然后根据 TRUE 值过滤此列并删除所有可见行。有关详细信息,请参阅@brettdj 的答案:stackoverflow.com/questions/21774624/…
  • 您确定要删除整行吗?如果数据集重叠怎么办?如果您有 100 行,但 DS 2 从第 11 行开始,并且 DS1 中的第 20 行与 DS2 中的第 31 行相同,那么当您删除 DS1 的第 20 行时,您将删除 DS2 的第 9 行。
  • 如果数据像我的示例中那样并排,则列偏移量必须大于列数
  • @steinbitur 您正在测试的列之间的行中是否有数据?列之间的偏移量每天都一样吗?
  • 您可以使用@TimWilliams 的THIS 漂亮的代码来比较范围

标签: vba excel


【解决方案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

如果您在单元格中嵌入了逗号,则在 JOIN

中选择另一个字符

【讨论】:

  • Gary 你的回答几乎和蒂姆在我给的链接中发布的一样:)
  • @SiddharthRout:您参考中的代码更紧凑很多
  • 是的,但它确实回答了 OP 的问题,而且它有详细的解释:) 理想情况下,您应该将这个问题作为副本关闭。但无论如何,我把决定留给你:)
【解决方案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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2022-11-05
    • 2020-03-30
    • 2010-11-24
    • 1970-01-01
    • 1970-01-01
    • 2014-06-05
    • 2010-12-18
    相关资源
    最近更新 更多