在Excel中取消合并真值表

Question

我有一个已合并的真值表。该真值表用于根据模型命名法来确定使用什么组件。每行代表型号中的数字。

我希望取消合并它，这样我可能为每个独特的配置都有一行。如下所示。

这是第一个未合并的装配编号的示例。

我没有成功尝试下面的 VBA 脚本，但我愿意接受所有选项，包括基于单元格的公式来尝试和解决：

Sub UnconsolidateList()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(4) 'Change to your sheet number
    
    Dim lastRow As Integer
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim i As Integer
    For i = lastRow To 4 Step -1
        Dim configs() As String
        configs = Split(ws.Cells(i, 3).Value, ",")
        
        Dim capacities() As String
        capacities = Split(ws.Cells(i, 4).Value, ",")
        
        Dim vents() As String
        generation = Split(ws.Cells(i, 5).Value, ",")
        
        Dim cases() As String
        factoryops = Split(ws.Cells(i, 6).Value, ",")
        
        Dim j As Integer, k As Integer, l As Integer, m As Integer
        
        For j = LBound(configs) To UBound(configs)
            For k = LBound(capacities) To UBound(capacities)
                For l = LBound(generation) To UBound(generation)
                    For m = LBound(factoryops) To UBound(factoryops)
                        If j + k + l + m > 0 Then 'Avoid duplicating the original row
                            lastRow = lastRow + 1 'Increment the row number where data will be inserted
                            ws.Rows(lastRow & ":" & lastRow).Insert Shift:=xlDown 'Insert a new row at the end of the list
                            
                            ws.Cells(lastRow - 1, "A").Copy Destination:=ws.Cells(lastRow, "A")   'Copy part no.
                            ws.Cells(lastRow - 1, "B").Copy Destination:=ws.Cells(lastRow, "B")   'Copy type

                            ws.Cells(lastRow, "C").Value2 = Trim(configs(j))
                            ws.Cells(lastRow, "D").Value2 = Trim(capacities(k))
                            ws.Cells(lastRow, "E").Value2 = Trim(generation(l))
                            ws.Cells(lastRow, "F").Value2 = Trim(factoryops(m))
                        End If
                    Next m
                Next l
            Next k
        Next j
    Next i
End Sub

Answer 1

• 您不需要指定包含组合项目的列。典型的递归函数可以处理所有组合。

Option Explicit
Sub Demo()
    Dim i As Long, j As Long, c As Variant
    Dim arrData, arrRes, iR As Long, aRow() As Variant
    Dim LastRow As Long, ColCnt As Long
    Dim oSht1 As Worksheet, aTxt
    Dim oColl As New Collection
    Set oSht1 = Sheets("Sheet1") ' modify as needed
    ' load source table
    arrData = oSht1.Range("A1").CurrentRegion.Value
    ColCnt = UBound(arrData, 2)
    ReDim aRow(ColCnt - 1)
    ' loop through each row
    For i = LBound(arrData) + 1 To UBound(arrData)
        ' split all items
        For j = LBound(arrData, 2) To UBound(arrData, 2)
            aRow(j - 1) = Split(arrData(i, j), ",")
        Next j
        GenerateCombinations oColl, aRow
    Next i
    ' populate output
    ReDim arrRes(1 To oColl.Count, ColCnt - 1)
    iR = 0
    For Each c In oColl
        aTxt = Split(c, "|")
        iR = iR + 1
        For j = 0 To UBound(aTxt)
            arrRes(iR, j) = aTxt(j)
        Next
    Next
    ' write output to new sheet
    Sheets.Add
    Range("A1").Resize(, ColCnt).Value = oSht1.Range("A1").Resize(, ColCnt).Value
    Range("A2").Resize(iR, ColCnt).Value = arrRes
End Sub

Sub GenerateCombinations(ByRef oColl As Object, aVals() As Variant, Optional curStr As String = "", Optional colIdx As Long = 0)
    Dim i As Long
    ' If the current index equals the length of the array
    If colIdx = UBound(aVals) + 1 Then
        '        Debug.Print curStr
        oColl.Add Mid(curStr, 2)
        Exit Sub
    End If
    ' Loop through each element in the current array and recursively call GenerateCombinations
    For i = LBound(aVals(colIdx)) To UBound(aVals(colIdx))
        GenerateCombinations oColl, aVals, curStr & "|" & aVals(colIdx)(i), colIdx + 1
    Next i
End Sub