Question

给出以下数据列：

portfolioID portfolioName   entityID    entityName
-188    India   643365  someLeaf1
-188    India   642925  someLeaf2
-188    India   643008  someLeaf3
-188    India   66280   Cash
-187    Main    -186    Golf
-187    Main    -181    Charlie
-187    Main    66280   Cash
-187    Main    66281   Alpha
-187    Main    66283   Bravo
-186    Golf    -185    Hotel
-186    Golf    -183    Juliet
-186    Golf    66280   Cash
-185    Hotel   -188    India
-185    Hotel   397660  Xray
-185    Hotel   66280   Cash
-183    Juliet  -182    Kilo
-183    Juliet  66280   Cash
-183    Juliet  66281   Lima
-182    Kilo    596371  someLeaf4
-182    Kilo    66280   Cash
-182    Kilo    602616  someLeaf5
-182    Kilo    602617  someLeaf6
-181    Charlie -180    Delta
-181    Charlie -179    Echo
-181    Charlie 66280   Cash
-180    Delta   641311  someLeaf7
-180    Delta   641312  someLeaf8
-180    Delta   641313  someLeaf9
-180    Delta   641314  someLeaf10
-180    Delta   66280   Cash
-179    Echo    66280   Cash
-179    Echo    66281   Foxtrot

您可以从上面的关系派生一棵树，其中PortfolioName是父母，而EntityName是孩子：

我想对此进行迭代，并使用childRanges构建父母的脚本字典。这是我当前的代码：

For Each parent In parentRange
    If Not dict.Exists(parent.Value) Then
        childCount = Application.WorksheetFunction.CountIf(parentRange, parent.Value)
        Set childrenRange = parent.Offset(, 2).Resize(childCount, 1)
        dict.Add parent.Value, Application.Transpose(Application.Transpose(childrenRange.Value))
    End If
Next

但是，当数据没有被父母排序时，这是行不通的。如何最有效地将我的childrenRange更改为正确的孩子列表？

而且，是否有可能总是让“现金”成为孩子数组的最后一个元素？

尝试：

for Each parent In parentRange
        If Not dict.Exists(parent.Value) Then
            childCount = Application.WorksheetFunction.CountIf(parentRange, parent.Value)
            'Set childrenRange = parent.Offset(, 2).Resize(childCount, 1)
            Dim childrenArr() As String
            ReDim childrenArr(childCount)
            Dim c As Integer
            c = 0
            For i = 1 To num_rows
                If Cells(i, f2.Column).Value = parent Then
                    childrenArr(c) = Cells(i, f2.Column).Offset(2, 0)
                    c = c + 1
                End If
            Next i
            dict.Add parent.Value, childrenArr
        End If
    Next

Answer 1

类似这样的东西：

Sub Tester()
    Dim parentRange As Range, p As Range, c
    Dim m, childrenArr() As String, tmp
    Dim dict, childCount As Long, k
    Set dict = CreateObject("scripting.dictionary")

    Set parentRange = Range("B2:B33")

    For Each p In parentRange
        'create an empty array if a new key
        If Not dict.Exists(p.Value) Then
            childCount = Application.WorksheetFunction.CountIf(parentRange, p.Value)
            ReDim childrenArr(0 To childCount - 1)
            dict.Add p.Value, childrenArr
        End If

        tmp = dict(p.Value) '<<get the array
        c = p.Offset(0, 2).Value
        If c = "Cash" Then
            tmp(UBound(tmp)) = c
        Else
            'find first empty slot (will be 1-based)
            m = Application.Match("", tmp, 0)
            tmp(m - 1) = c 'minus one because array is 0-based
        End If
        dict(p.Value) = tmp '<<return the array
    Next

    For Each k In dict.keys
        Debug.Print k, Join(dict(k), ", ")
    Next k

End Sub

注意：如果要使用字典中包含的数组，则首先需要将其从字典中拉出。

vba-建立父子键值对的字典

1 个答案: