Question

尝试为每一行创建所有唯一值组合，因为每个单元格可能有也可能没有多个嵌套值。目标是解释每一行并为每个唯一的值组合写一个新行。

Sub combo(x As Integer, splitCell As Boolean, lastcol As Long)
Dim cellArray() As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Test")

    For y = lastcol To 2 Step -1
    Dim counter As Integer
    counter = 0
        cellValue = ws.Cells(x, y).Value
        cellArray() = Split(cellValue, Chr(10))
        Debug.Print cellValue
        If UBound(cellArray()) > LBound(cellArray()) Then
           Debug.Print "Splitting " & x, y

           For t = UBound(cellArray()) To LBound(cellArray()) Step -1

                Rows(x + counter).Offset(1).EntireRow.Insert
                counter = counter + 1

                For a = lastcol To 1 Step -1
                If a = y Then
                    ws.Cells(x + counter, a).Value = cellArray(t)
                    splitCell = True
                    rowToDel = x
                Else
                    ws.Cells(x + counter, a).Value = ws.Cells(x, a).Value
                    splitCell = True
                End If

                Next a
           Next t
        End If
    x = x + counter
    Next y
    If splitCell = True Then
            Rows(rowToDel).EntireRow.Delete
    End If
x = x - 1
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row



End Sub

此代码目前适用于具有嵌套值的一个单元格与该行中其他单元格中的单个条目的情况。但是，最多可以有三列，每列都有嵌套值，应该为其创建唯一条目。

Answer 1

在下面的评论中，我假装您要拆分的数据是逗号分隔的。我这样做只是因为使用逗号显示示例比使用制表符更容易。包含的代码仍然使用制表符作为分隔符。

如果我正确理解你的问题，当你有一个值（例如）＆＃34; 1,4,67＆＃34;在Q列中，您的代码正确地生成了额外的行 - 一个用＆＃34; 1＆＃34;在Q栏中，一个用＆＃34; 4＆＃34;在Q栏中，一个用＆＃34; 67＆＃34;在Q列中，从原始行复制所有其他列。

但是，当你有第二个包含多个逗号分隔值的单元格时，请说＆＃34; A，B＆＃34;在T栏中，＆＃34; A，B＆＃34;仍然出现在前两个生成的行中的每一行上，并且仅在第三行上分割 - 因此总共创建了4行。但是你想要生成六行（每个值为＃34; A，B和＃34;每个值为＆＃34; 1,4,67和＃34;）。

我还假设您正在为原始数据中的每一行调用子例程。

以下代码将处理一行，展开每个值，以便获得每个组合：

Sub combo(x As Integer, splitCell As Boolean, lastcol As Long)
    Dim cellArray() As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim t As Long
    Dim y As Long
    Dim a As Long
    Dim cellValue
    Dim dstRow As Integer
    Dim srcRow As Integer
    Dim aCellWasSplit As Boolean

    srcRow = x
    dstRow = x
    splitCell = False
    Do While srcRow <= dstRow
        aCellWasSplit = False
        For y = lastcol To 2 Step -1
            cellValue = ws.Cells(x, y).Value
            cellArray() = Split(cellValue, Chr(10))
            Debug.Print cellValue
            If UBound(cellArray()) > LBound(cellArray()) Then
               Debug.Print "Splitting " & x, y
               aCellWasSplit = True

               For t = UBound(cellArray()) To LBound(cellArray()) Step -1

                    dstRow = dstRow + 1
                    Rows(dstRow).EntireRow.Insert

                    For a = lastcol To 1 Step -1
                        If a = y Then
                            ws.Cells(dstRow, a).Value = cellArray(t)
                        Else
                            ws.Cells(dstRow, a).Value = ws.Cells(srcRow, a).Value
                        End If
                    Next a
               Next t
               Exit For
            End If
        Next y
        If aCellWasSplit Then
            ws.Rows(srcRow).EntireRow.Delete
            dstRow = dstRow - 1
            splitCell = True
        Else
            srcRow = srcRow + 1
        End If
    Loop
    x = dstRow + 1
End Sub

以下代码可用于测试它：

Sub test()
    Dim anythingProcessed As Boolean
    Dim currentRow As Integer
    Dim lastCol As Long
    currentRow = 1
    lastCol = 5
    Do While currentRow <= ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        combo currentRow, anythingProcessed, lastCol
    Loop
End Sub

为每行

1 个答案: