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

我在how to build parent-child data table in 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

VBA如何建立关系表？

1 个答案: