vba - создание словаря пар родительских значений дочерних ключей

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

Вы можете получить дерево из вышеприведенных отношений, где имя_портрета - это родители, а имя_приятия - это потомки:

Я хочу повторить это и создать словарь сценариев для родителей с 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 на правильный список детей?

Кроме того, можно ли всегда иметь "Cash" в качестве последнего элемента массива потомков?

Попытка:

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

Примечание: если вы хотите работать с массивом, содержащимся в словаре, вам сначала нужно извлечь его из словаря.