vba - 从 excel 中的未知范围大小中提取唯一项目及其计数

Question

我需要从 Sheet1 上的 A 列中提取唯一名称，而在 Sheet2 上仅显示每个名称中的一个及其出现的次数。表 1 上的名称每天都在变化，所以我无法硬编码其中任何一个。

Sheet1:
A
Joe    
Joe
Paul
Steve 
Steve
Steve

Sheet2:
A      B 
Joe    2
Paul   1
Steve  3

我到目前为止的代码:

Sub testing()
    Dim data As Variant, temp As Variant
    Dim obj As Object
    Dim i As Long
    Set obj = CreateObject("scripting.dictionary")
    data = Selection
    For i = 1 To UBound(data)
        obj(data(i, 1) & "") = ""
    Next
    temp = obj.keys
    Selection.ClearContents
    Selection(1, 1).Resize(obj.count, 1) = Application.Transpose(temp)
End Sub

但是，这本身会产生错误。

它给了我:

Joe 
Joe
Paul
Steve

Answer 1

考虑使用 .删除重复项 :

Sub CountUniques()
   Dim r1 As Range, r2 As Range, r As Range
   Dim wf As WorksheetFunction

   Set wf = Application.WorksheetFunction
   Set r1 = Sheets("Sheet1").Columns(1).Cells
   Set r2 = Sheets("Sheet2").Range("A1")

   r1.Copy r2
   r2.EntireColumn.RemoveDuplicates Columns:=1, Header:=xlNo

   For Each r In r2.EntireColumn.Cells
      v = r.Value
      If v = "" Then Exit Sub
      r.Offset(0, 1).Value = wf.CountIf(r1, v)
   Next r
End Sub