查找和计算重复的数量答案

【问题标题】：Finding and counting number of duplicates查找和计算重复的数量
【发布时间】：2016-11-29 16:56:14
【问题描述】：

我有一个电子表格，其中包含一个名为 NumberID 的列，其中包含大约 50k 条记录。我知道有重复，但是向上/向下滚动需要永远找到任何东西，而且经常 excel 有点慢。我正在尝试编写一个快速的 sn-p 代码，以便能够找到并计算重复的数量。

我正在尝试编写一种快速的方法，基本上我的数据是从第 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已经生锈了

【问题讨论】：

如果你唯一的问题是匹配错误，这可能是stackoverflow.com/questions/17751443/…的重复
@TJRockefeller - 代码看起来是否正常
您展示的所有内容都在使用 B 列，但您在匹配的第一个标准中的参考是使用 A 列。我建议将 Cells(iCntr, 1) 都更改为 Cells(iCntr, 2)
@Bobski 我不确定你在最后的评论中说什么，但是用例是不同的，但我认为我放置链接的问题的答案本质上是答案你正在寻找。您需要使用 Application.Match 以便处理未找到匹配项的情况。
我不知道如何将其合并到我的代码中 - 该问题显示了针对相同问题但不同场景的解决方案

标签： vba excel worksheet-function

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

【讨论】：

由于某种原因 lastrow =19 但有很多行数据实际上从第 20 行开始到 48210
@Bobski - Range 和 Cells 在此示例中不合格。如果你从一个模块运行它，他们可能没有引用正确的工作表，所以你应该完全限定它们。否则，请参阅Error in finding last used cell in VBA。

【解决方案2】：

因为你想“计算重复的数量”，一个非常快速的方法是利用Range对象的RemoveDuplicates()方法，如下：

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

【讨论】：

@Bobski，你试过这个吗？
是的，它给了我一个非常大的数字，在 96k 范围内 - 我认为它计算了所有记录 * 2
好吧，我已经在 A 列中使用大约 50k 行进行了测试，其中有预定义的重复次数（只是重复了多次 10 单元格模式）并且它有效。尝试单步执行代码并查看工作表中的操作以及查询即时窗口（?helperCol.Address. 或 ?helperCol.Count）。

【解决方案3】：

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

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

计数
正在删除
选择

它超越了 Excel 的内置功能，因为它允许在 a 上重复匹配

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

【讨论】：