查找重复的消息框VBA宏

Question

我目前拥有的代码快速有效地在列＃34; A＆＃34;中查找重复项。我正在使用非常大的数据集40-50,000行，有时甚至更多。虽然这段代码很好，如果没有找到重复项，它会抛出一个错误代码。

我可以通过删除＆＃34; On错误转到0＆＃34;但是它会复制粘贴整个数据集。有没有办法修改此代码以显示msg框，如果没有找到重复项？

如果没有，可能是一个单独的Sub，如果找到重复项，如果没有显示消息框，则会调用此Sub？虽然许多对于大型数据集来说效率不高。

Sub filtersort()

  Dim wsData As Worksheet, wsOutput As Worksheet
  Dim Rng As Range
  Dim LastRow As Long, LastCol As Long, i As Long, j As Long, n As Long
  Dim arr(), x, dict, arrOut()

  With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
  End With

  Set wsData = Worksheets("Sheet1")

  On Error Resume Next
  Set wsOutput = Sheets("Duplicate Data")
  wsOutput.Cells.Clear
  On Error GoTo 0

  If wsOutput Is Nothing Then
    Sheets.Add(after:=wsData).Name = "Duplicate Data"
    Set wsOutput = ActiveSheet
  End If
  LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
  LastCol = wsData.Cells(3, Columns.Count).End(xlToLeft).Column + 1

  Set Rng = wsData.Range("A3:A" & LastRow)

  x = wsData.Range("A4:V" & LastRow).Value
  Set dict = CreateObject("Scripting.Dictionary")

  For i = 1 To UBound(x, 1)
    If Not dict.exists(x(i, 1)) Then
      dict.Item(x(i, 1)) = ""
    Else
      j = j + 1
      ReDim Preserve arr(1 To j)
      arr(j) = x(i, 1)
    End If
  Next i

  ReDim arrOut(1 To UBound(x, 1), 1 To UBound(x, 2))
  For i = 1 To UBound(x, 1)
    If Not IsError(Application.Match(x(i, 1), arr, 0)) Then
      n = n + 1
      For j = 1 To UBound(x, 2)
        arrOut(n, j) = x(i, j)
      Next j
    End If
  Next i

  wsData.Range("A3:V3").Copy wsOutput.Range("A3")

  wsOutput.Range("A4").Resize(n, UBound(x, 2)).Value = arrOut

  LastRow = wsOutput.Cells(Rows.Count, 1).End(xlUp).Row

  wsOutput.Range("A3:V" & LastRow).Sort Key1:=wsOutput.Range("A4"), 
  Order1:=xlDescending, Header:=xlYes
  With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
  End With
End Sub                          

Answer 1

我不相信你的代码和你想象的那样高效。有许多方法可以找到重复项：一种是使用Dictionary或Collection对象，它只接受唯一值作为其键;另一种方法是调用Application.Match函数并测试阳性结果。您的代码似乎同时执行这两项操作，因此您最好选择其中一种。下面的示例代码使用Dictionary，因为它还回答了有关对任何重复项进行测试的问题。

您的帖子中还有相当多的冗余代码。从未使用的LastCol，Rng等。

如果可以的话，避免逐步重新调整阵列也是一件好事。鉴于您知道您的唯一值字典的大小，Redim只能完成一次。

您可以再次利用.Count的{​​{1}}属性来测试是否存在重复项，如下面的代码所示。

所以，这是代码可以运行的一种方式：

<强>更新

评论的调整。主要区别在于使用布尔标志进行重复测试，但也会检测第一个和最后一个重复数据。

Dictionary

Answer 2

不完全是你问的问题，但我的免费Duplicate Master addin对数组是最好的，超出了正常的重复功能