查找并计算重复数量

Question

我有一个名为NumberID的电子表格，其中包含大约50,000条记录。我知道有重复但是滚动向上/向下需要永远找到任何东西加上往往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 - 我发现这个属性可以用来完成我想要做的事情。错误说

  

无法获取工作表函数类的匹配属性。

有人有想法吗？我的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

因为你想＆＃34;计算重复数量＆＃34; ，非常快速的方法就是利用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的内置功能，因为它允许在

上进行重复匹配

1. 案件代理基础
2. 忽略空白
3. 偶RegexP匹配
4. 运行多张