カラム内のユニークなデータをカウントしてから別のユニークなデータと照合してください

これは恥ずかしいほど簡単な質問ですが、私は何時間もそれを理解する方法やオンライン検索からアイデアを見つける方法を見つけることができませんでした。（ - ）上記コラム番号IDにすることもできるカラム内のユニークなデータをカウントしてから別のユニークなデータと照合してください

Name No. ID 
A  A1 
B  B4 
B  B5 
C  C0 
D  - 
A  A1 
A  A2 
E  - 
F  - 
C  C0 
B  B5 
B  B5 
B  B5 
B  B6 
A  A1 
A  A1 
A  A2 
B  B3 
B  B3 
B  B3

文字：

私はExcelシート（表1）で次のデータ（実際のデータは、数千または数百万であることができる）があると番号0または空白のセル。私は以下のように上記データをフォーマットする

（表2）

Name Number of ID 
A  2 
B  4 
C  1 
D  0 
E  0 
F  0

これはA 2つのID（A1及びA2）を有し、Bが4つのID（B1、B2、B3、およびB4）を有しています、Cは1つのID（C0）を持ち、D、E、FはIDを持たない。

私はピボットテーブルを使用することによって得ることができる最高はこの

どのように1は、MS Excelの表2のようなタスクを実行しないようなものですか？可能であれば、それのVBAスクリプト。

出典

2016-06-24 Anastasiya-Romanova 秀

上記の問題のためのVBAソリューションに興味のある人の場合：

Sub GetUniquesCount() 
    Dim dict1 As Object, dict2 As Object 
    Dim c1 As Variant, c2 As Variant 
    Dim i As Long, lastRow As Long, count As Long 

    Set dict1 = CreateObject("Scripting.Dictionary") 
    Set dict2 = CreateObject("Scripting.Dictionary") 

    lastRow = Cells(Rows.count, "A").End(xlUp).Row 
    c1 = Range("A2:A" & lastRow) 
    For i = 1 To UBound(c1, 1) 
     dict1(c1(i, 1)) = 1 
    Next i 
    Range("D2").Resize(dict1.count) = Application.Transpose(dict1.keys) 

    lastRow = Cells(Rows.count, "B").End(xlUp).Row 
    c2 = Range("B2:B" & lastRow) 
    For i = 1 To UBound(c2, 1) 
     dict2(c2(i, 1)) = 1 
    Next i 

    For Each cel In Range("D2:D" & Cells(Rows.count, "D").End(xlUp).Row) 
     count = 0 
     For Each k2 In dict2.keys 
      If k2 Like cel.Value & "*" Then 
       count = count + 1 
      End If 
     Next k2 
     cel.Offset(0, 1).Value = count 
    Next cel 
End Sub