宏检查列并根据值对行进行计数

Question

我有一组列，每个列中的值都不同，我想构建一个列以根据值对每个列中的行进行计数。它尝试了以下代码，该代码只能帮助我计算特定值，但我想计算该列中所有可用的值。例如：如果该列具有3个不同的值，则宏应给出3个不同的结果，例如IRB（1,582），Slotting（113），Standardized（875）。请找到我为所有行都具有相同值的列尝试的以下查询。

Sub Organisational_unit_level_1()
    Dim A As String
    Dim r As Range
    Dim wf As WorksheetFunction
    Set wf = Application.WorksheetFunction
    A = "Barclays International"
    Set r = Range("A:A")
    A = "*" & A & "*"
    [B3] = wf.CountIf(r, A)
End Sub

Answer 1

不知道如何获取输出，但这会给您一个想法。 该宏使用Dictionary对象返回A列中唯一项的计数。

'Set reference to Microsoft Scripting Runtime
'  or use late binding
Option Explicit
Sub UniqueCounts()
    Dim myD As Dictionary
    Dim vArr As Variant
    Dim WS As Worksheet
    Dim I As Long, sKey As String, v As Variant, s As String

Set WS = ThisWorkbook.Worksheets("sheet1")
With WS
    vArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set myD = New Dictionary
    myD.CompareMode = TextCompare

For I = 1 To UBound(vArr)
    sKey = vArr(I, 1)
    If Not myD.Exists(sKey) Then
        myD.Add Key:=sKey, Item:=1
    Else
        myD(sKey) = myD(sKey) + 1
    End If
Next I

For Each v In myD
    s = s & vbLf & v & " (" & myD(v) & ")"
Next v

s = Mid(s, 2)
MsgBox (s)

End Sub

关于随机生成的数据的结果示例：