0

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

我需要计算所有类型的关系：A 列中每个名称的自我、老板、同行、直接下属、其他

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

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

例子

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

谢谢

在 AI 列中有“分组名称

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

在 BI 列中有关系

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

1 回答 1

0

除了 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
于 2013-06-03T15:32:00.030 回答