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

Posted 2023-03-29

【中文标题】使用 excel vba 计算每行中的重复值和报告重复数

【英文标题】：count duplicate value and report number of duplicate in each row with excel vba

【发布时间】：2021-04-02 17:29:20

【问题描述】：

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 代码？ 我认为它应该循环以将每一行中的值与所有值和计数进行比较。

【问题讨论】：

类似this？您只需要一个COUNTIF 公式。无需 VBA

这里有我对您问题的详细回答***.com/questions/65434617/…（使用 VBA 或工作表函数）以及您可能想要查看的另外两个问题。只需将那里使用的 B 列更改为您在问题中使用的 A 列。

这能回答你的问题吗？ i want to get the frequency of a data in a column using vba

【参考方案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

【讨论】：

感谢您的回答，但结果不正确。 app.box.com/s/77ci69xo9cw139r1i81a6qzkf794s54y

delete -1 from ActiveSheet.Range("B" & i) = CountThisItem(rng_WorkRange, str_Text) - 1 对于你的情况，我的意思是 b 列中的数字是重复项的数量。如果没有应该是 0