通过换行拆分单元格，同时保留其他数据

Question

我在电子表格中设置了多行，如下所示：

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

Answer 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

Answer 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

输入

输出