查找和计算重复项的数量

Question

我有一个电子表格，其中包含一个名为 NumberID 的列，其中包含大约 50k 条记录。我知道有重复项，但是滚动 up/down 需要很长时间才能找到任何东西，而且 excel 经常有点慢。我正在尝试编写一小段代码，以便能够查找和计算重复项的数量。

我正在尝试编写一种快速的方法，基本上我的数据是从第 20 行到 48210 行，我正在尝试查找重复记录总数。

Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
Dim count As Long
count = 0
lastRow = Range("B48210").End(xlUp).Row
For iCntr = 1 To lastRow
    If Cells(iCntr, 1) <> "" Then
       matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("B20:B" & lastRow), 0)
        If iCntr <> matchFoundIndex Then
            count = count + 1
        End If
     End If
Next

MsgBox count

这里我在 = WorkSheetFunction.Match 上遇到错误 - 我发现这个属性可以用来完成我想做的事情。错误显示

Unable to get the match property for the worksheetfunction class.

有人有想法吗？我的vba生锈了

Answer 1

为此使用 Match 很多行的效率非常低。我会用找到的物品填充 Dictionary 并测试一下你以前是否见过它们：

'Add a reference to Microsoft Scripting Runtime.
Public Sub DupCount()
    Dim count As Long
    With New Scripting.Dictionary
        Dim lastRow As Long
        lastRow = Range("B48210").End(xlUp).Row
        Dim i As Long
        For i = 1 To lastRow
            Dim test As Variant
            test = Cells(i, 2).Value
            If IsError(test) Then
            ElseIf test <> vbNullString Then
                If .Exists(test) Then
                    count = count + 1
                Else
                    .Add test, vbNull
                End If
            End If
        Next
    End With
    MsgBox count
End Sub

Answer 2

既然你想"count the number of duplicates"，一个非常的快速方法是利用RemoveDuplicates()方法Range 个对象，如下所示：

Option Explicit

Sub main()
    Dim helperCol As Range
    Dim count As Long

    With Worksheets("IDs") '<--| reference your relevant sheet (change "IDs" to youtr actual sheet name)
        Set helperCol = .UsedRange.Resize(, 1).Offset(, .UsedRange.Columns.count) '<--| set a "helper" range where to store unique identifiers
        With .Range("A1", .Cells(.Rows.count, 1).End(xlUp)) '<-- reference "IDs" column from row 1 (header) to last not empty cell
            helperCol.Value = .Value '<--| copy identifiers to "helper" range
            helperCol.RemoveDuplicates Columns:=1, Header:=xlYes '<--| remove duplicates in copied identifiers
            count = .SpecialCells(xlCellTypeConstants).count - helperCol.SpecialCells(xlCellTypeConstants).count '<--| count duplicates as the difference between original IDs number and unique ones
        End With
        helperCol.ClearContents '<--| clear "helper" range
    End With
    MsgBox count & " duplicates"
End Sub

Answer 3

您可以使用我的 Duplicate Masteer addin 来执行此操作。

它提供了一种快速的数组方法来处理重复项。

计数
正在删除
正在选择

它超越了 Excel 的内置功能，因为它允许在

上进行重复匹配

不区分大小写的基础
忽略空格
甚至RegexP匹配
运行多张纸

查找和计算重复项的数量

Finding and counting number of duplicates

excel

vba

worksheet-function