VBA Как мне сделать таблицу отношений?

Question

У меня есть данные таким образом в Excel

Таблица читается так.Для выполнения SKU L2-1 потребуется SKU L1-1 и L2-2.

Для завершения SKU L2-2 потребуется L1-3.

СледовательноSKU2-1 также потребуется L1-3 для удовлетворения требований L2-2

SKU    |Dependency 1|Dependency 2|Dependency 3
L2-1   |L1-1        |L2-2
L2-2   |L1-3        |
L2-3   |L1-1        |L2-1

Я бы хотел, чтобы макрос превратил Excel в этот вывод

SKU    |Dependency 1|Dependency 2|Dependency 3|Dependency 4
L2-1   |L1-1        |L2-2        |L1-3        |
L2-2   |L1-3        |            |            |
L2-3   |L1-1        |L1-2        |L2-2        |L1-3

Iнашел несколько схожий вопрос в о том, как построить таблицу родительских и дочерних данных в Excel? , однако, решение для меня слишком сложное, и оно идет по строке, а не по столбцу.

Answer 1

Я думаю, что что-то вроде следующего приведет вас на стадион:

Sub GetChildren()

    'Set your range we are reading from
    Dim dataRange As Range: Set dataRange = Sheet1.Range("A2:D4")

    'We are going to store our non-parent children in an array
    Dim ChildArr As Variant

    'Set up and initialize variables for loop
    Dim readRow As Range
    Dim writeRow As Integer: writeRow = 1
    Dim writeCol As Integer: writeCol = 1

    'Loop
    For Each readRow In dataRange.Rows

        'Redim this back to 1 element
        ReDim ChildArr(0 To 0)

        'Start the iteration. We are passing ChildArr ByRef and will use the output
        getChildren parent:=readRow.Cells(1, 1).Value, dataRange:=dataRange, ChildArr:=ChildArr

        'write out
        Sheet2.Cells(writeRow, writeCol) = readRow.Cells(1, 1).Value
        writeCol = writeCol + 1
        For Each childItem In ChildArr
            Sheet2.Cells(writeRow, writeCol) = childItem
            writeCol = writeCol + 1
        Next
        writeRow = writeRow + 1
        writeCol = 1
    Next readRow

End Sub
Sub getChildren(parent As String, dataRange As Range, ByRef ChildArr As Variant)

    'parentRange will hold the cell where we find the parent
    Dim parentRange As Range
    Set parentRange = dataRange.Columns(1).Find(parent)

    'childRange will hold the cells adjacent to the found parent
    Dim childrenRange As Range, childRange As Range
    Set childrenRange = parentRange.Offset(, 1).Resize(, WorksheetFunction.CountA(parentRange.Rows(1).EntireRow) - 2).Cells

    'We will iterate the children
    For Each childRange In childrenRange
        'We will test if the child is also a parent
        If dataRange.Columns(1).Find(childRange.Value) Is Nothing Then
            'It is not, so pop the array
            If ChildArr(0) <> "" Then ReDim Preserve ChildArr(0 To UBound(ChildArr) + 1)
            ChildArr(UBound(ChildArr)) = childRange.Value
        Else
            'It IS, so go find it's children
            getChildren parent:=childRange.Value, dataRange:=dataRange, ChildArr:=ChildArr
        End If
    Next childRange
End Sub