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

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

这个怎么运作

代码中有注释以突出显示正在发生的事情.这是一个高级概述:

• 总的来说,我们遍历数据的每一行,分别处理所有列.
• 当前单元格的文本正在Split使用vbLf.这给出了所有单独行的数组.
• 计数器正在跟踪添加的最大行数(实际上这是rows-1因为这些数组是0-indexed.
• 现在数据可以输出到新工作表.这很简单,因为我们可以转储Split为我们创建的数组.唯一棘手的部分是让它到达工作表上的正确位置.为此,有一个当前列偏移的计数器和一个全局计数器来确定需要偏移的总行数.该Offset移动我们到正确的细胞; 在Resize确保了所有的行的输出.最后,Application.Transpose需要因为Split返回一个行数组而我们正在转储一列.
• 更新计数器.列偏移每次递增.更新行偏移量以添加足够的行以覆盖最后一个最大值(+1因为这是0-indexed)
• 最后,我将在所有创建的空白单元格上使用我的瀑布填充(您之前的问题),以确保没有空白.我放弃了错误检查,因为我认为空白存在.