vba - 拆分具有多行文本和单行文本的行

Question

我试图弄清楚如何拆分数据行，其中行中的 B、C、D 列包含多行，而其他列则不包含。我已经弄清楚如何拆分多行单元格，如果我将这些列复制到新工作表中，手动插入行，然后运行下面的宏(仅适用于 A 列)，但我在编码时迷失了休息。

数据如下:

因此，对于第 2 行，我需要将其分为 6 行(单元格 B2 中的每一行各一行)，其中单元格 A2 中的文本位于 A2:A8 中。我还需要将 C 列和 D 列与 B 列进行相同的拆分，然后将 E:CP 列与 A 列进行相同的拆分。

这是我用于拆分 B、C、D 列中的单元格的代码:

Dim iPtr As Integer
Dim iBreak As Integer
Dim myVar As Integer
Dim strTemp As String
Dim iRow As Integer
iRow = 0
For iPtr = 1 To Cells(Rows.Count, col).End(xlUp).Row
    strTemp = Cells(iPtr1, 1)
    iBreak = InStr(strTemp, vbLf)
    Range("C1").Value = iBreak
        Do Until iBreak = 0
        If Len(Trim(Left(strTemp, iBreak - 1))) > 0 Then
            iRow = iRow + 1
            Cells(iRow, 2) = Left(strTemp, iBreak - 1)
        End If
        strTemp = Mid(strTemp, iBreak + 1)
        iBreak = InStr(strTemp, vbLf)
    Loop
    If Len(Trim(strTemp)) > 0 Then
        iRow = iRow + 1
        Cells(iRow, 2) = strTemp
    End If
Next iPtr
End Sub

这里是示例文件的链接(请注意，该文件有 4 行，实际工作表有超过 600 行):https://www.dropbox.com/s/46j9ks9q43gwzo4/Example%20Data.xlsx?dl=0

Answer 1

这是一个相当有趣的问题，我以前见过一些不同的问题。我继续为它编写了一个通用解决方案，因为它似乎是一段值得我自己保留的有用代码。

我对数据几乎只有两个假设:

• 返回值由 Chr(10) 或 vbLf 常量表示。
• 属于较低行的数据有足够的返回值以使其对齐。这似乎是你的情况，因为有返回字符似乎使事情按照你想要的方式排列。

输出图片，缩小以显示 A:D 的所有数据。请注意，下面的代码默认处理所有列并输出到新工作表。如果您愿意，您可以限制列数，但将其变得通用太诱人了。

代码

Sub SplitByRowsAndFillBlanks()

    'process the whole sheet, could be
    'Intersect(Range("B:D"), ActiveSheet.UsedRange)
    'if you just want those columns
    Dim rng_all_data As Range
    Set rng_all_data = Range("A1").CurrentRegion

    Dim int_row As Integer
    int_row = 0

    'create new sheet for output
    Dim sht_out As Worksheet
    Set sht_out = Worksheets.Add

    Dim rng_row As Range
    For Each rng_row In rng_all_data.Rows

        Dim int_col As Integer
        int_col = 0

        Dim int_max_splits As Integer
        int_max_splits = 0

        Dim rng_col As Range
        For Each rng_col In rng_row.Columns

            'splits for current column
            Dim col_parts As Variant
            col_parts = Split(rng_col, vbLf)

            'check if new max row count
            If UBound(col_parts) > int_max_splits Then
                int_max_splits = UBound(col_parts)
            End If

            'fill the data into the new sheet, tranpose row array to columns
            sht_out.Range("A1").Offset(int_row, int_col).Resize(UBound(col_parts) + 1) = Application.Transpose(col_parts)

            int_col = int_col + 1
        Next

        'max sure new rows added for total length
        int_row = int_row + int_max_splits + 1
    Next

    'go through all blank cells and fill with value from above
    Dim rng_blank As Range
    For Each rng_blank In sht_out.Cells.SpecialCells(xlCellTypeBlanks)
        rng_blank = rng_blank.End(xlUp)
    Next

End Sub

工作原理

代码中有注释来突出显示正在发生的事情。以下是高级概述:

• 总体而言，我们会迭代数据的每一行，并单独处理所有列。
• 使用vbLf对当前单元格的文本进行Split。这给出了所有单独行的数组。
• 计数器正在跟踪添加的最大行数(实际上是 rows-1，因为这些数组是 0 索引。
• 现在可以将数据输出到新工作表中。这很容易，因为我们可以转储 Split 为我们创建的数组。唯一棘手的部分是将其放置在纸张上的正确位置。为此，有一个用于当前列偏移的计数器和一个全局计数器来确定需要偏移的总行数。 Offset 将我们移动到右侧的单元格； Resize 确保输出所有行。最后，需要 Application.Transpose，因为 Split 返回行数组，而我们要转储列。
• 更新计数器。列偏移量每次都会增加。行偏移量已更新，以添加足够的行来覆盖最后一个最大值(+1，因为这是 0 索引)
• 最后，我到达use my waterfall fill (your previous question)在为确保没有空白而创建的所有空白单元格上。我放弃了错误检查，因为我假设存在空白。