如何使用 VBA 模块计算新工作表中输出中的重复值

Question

我需要使用 VBA 模块从源工作表“Rawdata”计算新工作表中的重复值。在不同工作表中 ID 前面的特定列中重复相同值的次数。

我已经通过数据透视表完成，但我想通过 VBA 模块在按钮单击事件上执行此操作。

原始来源页面

预期输出工作表如下：

我已尝试通过更新正确的工作表名称来使用以下代码，但出现如下类型不匹配错误：

我正在使用以下代码，但我通过插入新列手动将整个列数据从位置“Y”(25) 复制到第一个 (“A”)。

修改工作表

Option Explicit

 Sub CountDuplicates()

Dim a As Variant, b As Variant, e As Variant
  Dim d As Object
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  
  d.CompareMode = 1
  
  b = Sheets("Rawdata").Range("A3").CurrentRegion.Resize(, 1).Value
  
  ReDim Preserve b(1 To UBound(b), 1 To 2)
  a = Sheets("Rawdata").UsedRange.Value
  
  For Each e In a
  
    If Len(e) > 0 Then
      d(e) = d(e) + 1
    End If
    
  Next e
  
  For i = 1 To UBound(b)
    b(i, 2) = d(b(i, 1))
  Next i
  
  Sheets("DuplicateCount").Range("A1:B1").Resize(UBound(b)).Value = b
End Sub

**现在我的输出结果工作表有重复计数（不明显）。我的意思是 ID 列不是唯一的。尽管将源列中的格式更改为文本，但结果中的数值与计数重复 **

Answer 1

这就是它的实现方式。根据您的更改工作表名称。

Option Explicit

 Sub CountDuplicates()

  Dim a As Variant, b As Variant, e As Variant
  Dim d As Object
  Dim i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  
  d.CompareMode = 1
  
  b = Sheets("Rawdata").Range("Y3:Y10000").Value
  
  ReDim Preserve b(1 To UBound(b), 1 To 2)
  a = Sheets("Rawdata").UsedRange.Value
  
  For Each e In a
  
    If Len(e) > 0 Then
      d(e) = d(e) + 1
    End If
    
  Next e
  
  For i = 1 To UBound(b)
    b(i, 2) = d(b(i, 1))
  Next i
  
  Sheets("DuplicateCount").Range("A1:B1").Resize(UBound(b)).Value = b
  
End Sub