使用 excel vba 计算每行中的重复值和报告重复数

Question

A列有很多ID，有重复值如cell(A2) ID 300502489400, cell(A3) ID 300502520900, cell(A4) ID 300502520900, cell(A5) ID 300502520900, cell(A6) ID 300502523900,单元格(A7) ID 300502520900，

我需要计算重复的数量并在 B 列中报告 结果如 细胞（B2）=1，细胞（B3）=4，细胞（B4）=4，细胞（B5）=4，细胞（B6）=1，细胞（B7）=1，

如何在 Excel 中编写 VBA 代码？ 我认为它应该循环以将每一行中的值与所有值和计数进行比较。

Answer 1

您可以使用函数来检查范围和计算重复项

Function CountThisItem(CountingRange As Range, a As String) As Integer
Dim rng_FindRange As Range
Dim LA As String

Set rng_FindRange = CountingRange.Find(a, lookat:=xlWhole)
If Not rng_FindRange Is Nothing Then
    LA = rng_FindRange.Address
    CountThisItem = 1
    Do
        Set rng_FindRange = CountingRange.Find(a, lookat:=xlWhole, after:=rng_FindRange)
        If Not rng_FindRange Is Nothing And rng_FindRange.Address <> LA Then CountThisItem = CountThisItem + 1
    Loop While rng_FindRange.Address <> LA
Else
    CountThisItem = 0
End If
End Function

用于子。函数查找所有项目，因此重复项的数量为- 1

Sub FindDuplicates()
Dim int_LastRow As Integer
Dim rng_WorkRange As Range
Dim str_Text As String

int_LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Set rng_WorkRange = ActiveSheet.Range("A1:A" & int_LastRow)

For i = 1 To int_LastRow
    str_Text = ActiveSheet.Range("A" & i)
    ActiveSheet.Range("B" & i) = CountThisItem(rng_WorkRange, str_Text) - 1
Next i
End Sub