按换行符拆分单元格，同时保留其他数据答案

【问题标题】：Split cells by line break while keeping other data按换行符拆分单元格，同时保留其他数据
【发布时间】：2019-06-27 14:21:01
【问题描述】：

我在电子表格中有多行设置如下：

TEST    1   Y   N    TEST_1            1234      Derived
                     TEST_2            56

我需要拆分有换行符的单元格，同时将剩余的单元格复制到新行中：

TEST    1   Y   N    TEST_1            1234      Derived
TEST    1   Y   N    TEST_2            56        Derived

我通过将换行符更改为逗号来测试代码（我不知道换行符的 VBA 符号）。我尝试的代码仅适用于 E 列，而不适用于 F 列：

Sub splitByCol()
  Dim r As Range, i As Long, ar
  Set r = Worksheets("Sheet1").Range("E999999:F999999").End(xlUp)
  Do While r.row > 1
    ar = Split(r.value, ",")
    If UBound(ar) >= 0 Then r.value = ar(0)
    For i = UBound(ar) To 1 Step -1
      r.EntireRow.Copy
      r.Offset(1).EntireRow.Insert
      r.Offset(1).value = ar(i)
    Next
    Set r = r.Offset(-1)
  Loop
End Sub

【问题讨论】：

@ArcherBird 单元格内的换行符（使用 Alt+Enter 创建）实际上是 vbLf，即 Chr(10)，但 vbNewLine 是 Chr(13)，与vbCr（而 Windows 中的换行符意味着 vbCrLf）。 • TextToColumns 将不起作用，因为正如其名称所说，它将单元格拆分为 columns 而不是 OP 希望的行。
@ArcherBird 我尝试使用它，但它会覆盖右侧的数据。另外，我需要将数据放入另一行，而不是另一列。
@Pᴇʜ 我误解了 OP 的问题。但感谢vbnewline 的澄清。我学到了一些东西！

标签： excel vba

【解决方案1】：

我只是做了一个简短的测试，可能并不完美。如果您有大量的行和列，这也可能会有点慢。

    Dim rowiter As Long
    Dim coliter As Long
    Dim lastrow As Long
    Dim lastcol As Long
    Dim rowcount As Long
    Dim rowadd As Boolean
    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lastcol = .Cells.Find(What:="*", after:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
        rowcount = lastrow + 1

        For rowiter = 1 To lastrow
            rowadd = False
            For coliter = 1 To lastcol
                If InStr(1, .Cells(rowiter, coliter), vbLf) Then
                    .Cells(rowcount, coliter).Value = Split(.Cells(rowiter, coliter), vbLf)(1)
                    .Cells(rowiter, coliter).Value = Split(.Cells(rowiter, coliter), vbLf)(0)
                    rowadd = True
                End If
            Next
            If rowadd = True Then
                For coliter = 1 To lastcol
                    If .Cells(rowcount, coliter).Value = "" Or IsNull(.Cells(rowcount, coliter).Value) Then
                        .Cells(rowcount, coliter).Value = .Cells(rowiter, coliter).Value
                    End If
                Next
                rowcount = rowcount + 1
            End If
            rowadd = False
        Next
        .Range(Cells(1, 1), Cells(rowcount, lastcol)).Sort Key1:=Columns("A"), Order1:=xlDescending
    End With

【讨论】：

【解决方案2】：

其实你就快到了：

你需要用vbLf而不是","分割
您需要将 E 列和 F 列拆分为单独的数组

所以你最终得到：

Option Explicit

Sub splitByCol()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim CurrentCell As Range
    Set CurrentCell = ws.Range("E" & ws.Rows.Count).End(xlUp)

    Dim ArrE As Variant   'split array for column E
    Dim ArrF As Variant   'split array for column F

    Do While CurrentCell.Row > 1
        ArrE = Split(CurrentCell.Value, vbLf)
        ArrF = Split(CurrentCell.Offset(ColumnOffset:=1).Value, vbLf)

        If UBound(ArrE) >= 0 Then CurrentCell.Value = ArrE(0)
        If UBound(ArrF) >= 0 Then CurrentCell.Offset(ColumnOffset:=1).Value = ArrF(0)

        Dim i As Long
        For i = UBound(ArrE) To 1 Step -1
            CurrentCell.EntireRow.Copy
            CurrentCell.Offset(1).EntireRow.Insert

            CurrentCell.Offset(1).Value = ArrE(i)
            If UBound(ArrF) >= i Then
                CurrentCell.Offset(1, 1).Value = ArrF(i)
            Else
                CurrentCell.Offset(1, 1).Value = vbNullString
            End If
        Next i
        Set CurrentCell = CurrentCell.Offset(-1)
    Loop
End Sub

输入

输出

【讨论】：