计数字符串A相对于分组字符串B

Question

我有两列A列有分组名称B列有各种关系

我需要计算所有类型的关系:自我，老板，同事，直接报告，其他每个名字在A栏

我可以计算与下面Sub的所有关系，但我无法找到或弄清楚如何计算相对于名称组。

名称不断变化，所以我不能硬编码它们

例子

Betty Sue Self(1) Boss(1) Peer(3) Direct Report(1) Other(1)

感谢

在A列我有"分组名称

"

Betty Sue
Betty Sue
Betty Sue
Betty Sue
Betty Sue
Betty Sue
Fred Anderson
Fred Anderson
Fred Anderson
Molly Capra
Molly Capra
Molly Capra
Molly Capra
Molly Capra

B列中有Relationships

Self
Boss
Peer
Peer
Other
Direct Report
Peer
Self
Peer
Direct Report
Direct Report
Direct Report
Boss

Answer 1

除了Alistair的数据透视表的建议，我还有这个

打印到页面

Dim Str     As String
Set Rng = range(range("A1"), range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
For Each Dn In Rng
        If Not Dic.exists(Dn.Value) Then
            Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
        End If
        If Not Dic(Dn.Value).exists(Dn.Offset(, 3).Value) Then
            Dic(Dn.Value).Add (Dn.Offset(, 3).Value), 1
        Else
            Q = Dic(Dn.Value).Item(Dn.Offset(, 3).Value)
                Q = Q + 1
            Dic(Dn.Value).Item(Dn.Offset(, 3).Value) = Q
        End If
Next Dn
Dim C As Integer
Dim Ac As Integer
C = 4
For Each k In Dic.Keys
   C = C + 1
   Ac = 1
   Cells(Ac, C) = k
        For Each p In Dic(k)
           Ac = Ac + 1
            Cells(Ac, C) = p & " (" & Dic(k).Item(p) & ")"
        Next p
Next k
End Sub  

显示在MessageBox

Sub Report()
Dim Dn      As range
Dim Rng     As range
Dim Dic     As Object
Dim Q       As Variant
Dim k       As Variant
Dim p       As Variant
Dim Str     As String
Set Rng = range(range("A2"), range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
For Each Dn In Rng
        If Not Dic.exists(Dn.Value) Then
            Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
        End If
        If Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) Then
            Dic(Dn.Value).Add (Dn.Offset(, 1).Value), 1
        Else
            Q = Dic(Dn.Value).Item(Dn.Offset(, 1).Value)
                Q = Q + 1
            Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = Q
        End If
Next Dn
For Each k In Dic.Keys
   Str = Str & k & " :- "
        For Each p In Dic(k)
           Str = Str & p & " (" & Dic(k).Item(p) & ") , "
        Next p
    Str = Str & Chr(10)
Next k
MsgBox Str
End Sub