查找和计数重复的数量
我有一个名为NumberID的列有大约50klogging的电子表格。 我知道有重复，但滚动向上/向下它需要永远find什么加上往往是Excel的速度有点慢。 我试图写一个快速的代码片段，以便能够find并计算重复的数量。
我试图写一个快速的方式做到这一点，基本上我的数据是从20行到48210，我试图find一个总数重复的logging。
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 – 我发现这个属性可以用来完成我想要做的。 错误说
无法获取工作表function类的匹配属性。
有人有一个想法？ 我的vba已经生锈了
既然你想“重复计数” ，一个非常快速的方法是利用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
使用Match对于许多行来说是非常低效的。 我会用find的项目填写一个Dictionary ，只是testing看看你以前是否见过它们：
'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
你可以使用我的复制Masteer插件来做到这一点。
它提供了一个快速的数组方法来处理重复。
- 数数
- 删除
- select
它超越了Excel的内置function，因为它允许重复匹配一个
- 案件不知情的情况下
- 忽略空白
- 甚至
RegexP匹配 - 运行多张表
