Question

我有一系列数据，其中一些单元格有换行符，我需要将换行符拆分为发生换行符的行下面的行，但保留其他单元格不变。如果这会产生影响，也会有多个列。

我使用了下面提供的两个答案，并进行了一些调整以适合我的工作表，但两者都没有用于分割所有单元格。我最终都尝试了两者，但这也不起作用。

当A列中有换行符时，它正在工作，但是当A列中没有换行符，而另一列中有换行符时，它不起作用。如果A列中没有换行符，我只需要将换行符分开并将其合并到下面的行中。

以下是代码：

end_row = range("A" & Rows.count).End(xlUp).row

range("A:A").TextToColumns Destination:=range("a1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
    :="   ", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

For i = 1 To end_row
    row_added = False
    For j = 1 To 4
        If InStr(1, Cell, Chr(10)) <> 0 Then
            If Not row_added Then
                Rows(i + 1).Insert
                row_added = True
                end_row = end_row + 1
            End If
            Cells(i + 1, j) = Right(Cells(i, j), Len(Cells(i, j)) - InStr(1, Cell, Chr(10)))
            Cells(i, j) = Left(Cells(i, j), InStr(1, Cell, Chr(10)) - 1)
        End If
    Next j
Next i

和

Sub LFtoRow()
Dim myWS As Worksheet, myRng As range
Dim LastRow As Long, iLoop As Long, jLoop As Long
Dim myString() As String

Set myWS = ActiveSheet
LastRow = myWS.Cells(myWS.Rows.count, 1).End(xlUp).row

For iLoop = LastRow To 1 Step -1
    myString = Split(myWS.Cells(iLoop, 1), Chr(10))
    If UBound(myString, 1) > 0 Then
        myWS.Rows(iLoop + 1 & ":" & iLoop + UBound(myString, 1)).Insert shift:=xlShiftDown
        For jLoop = 0 To UBound(myString, 1)
            myWS.Cells(iLoop + jLoop, 1) = myString(jLoop)
        Next jLoop
    End If
Next iLoop

End Sub

要么完全使用新代码，要么添加到最后的代码都可以使用。我有一个关于正在发生的事情的例子，以及我希望它如下所示。（我知道它在照片中显示了B列，但在MACRO的这一点上，它在A列中）

发生了什么：

我需要做什么：

Answer 1

我会推荐类似以下的代码来解决您的问题。它具有以下属性：

使用分割功能在Chr（10）上确定每行所需的字符串。 Chr（10）是换行符。 Split为您生成一个字符串数组。
为您插入正确的行数。
从下至上循环浏览您的范围，以便处理整个范围。

代码......

Sub LFtoRow()
Dim myWS As Worksheet, myRng As Range
Dim LastRow As Long, iLoop As Long, jLoop As Long
Dim myString() As String

Set myWS = Worksheets("Sheet1")
LastRow = myWS.Cells(myWS.Rows.Count, 1).End(xlUp).Row

For iLoop = LastRow To 1 Step -1
    myString = Split(myWS.Cells(iLoop, 1), Chr(10))
    If UBound(myString, 1) > 0 Then
        myWS.Rows(iLoop + 1 & ":" & iLoop + UBound(myString, 1)).Insert Shift:=xlShiftDown
        For jLoop = 0 To UBound(myString, 1)
            myWS.Cells(iLoop + jLoop, 1) = myString(jLoop)
        Next jLoop
    End If
Next iLoop

End Sub

当出现此输入时......

...生成此结果......

Answer 2

这是我的建议，应该处理所有列中的换行符。

我也删除了插入“;”的替换品然后拆分。完整的代码将是：

end_row = Range("A" & Rows.Count).End(xlUp).Row

Range("A:A").TextToColumns Destination:=Range("a1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
    :="   ", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

For i = 1 To end_row
    row_added = False
    For j = 1 To 4
        If InStr(1, Cell, Chr(10)) <> 0 Then
            If Not row_added Then
                Rows(i + 1).Insert
                row_added = True
                end_row = end_row + 1
            End If
            Cells(i + 1, j) = Right(Cells(i, j), Len(Cells(i, j)) - InStr(1, Cell, Chr(10)))
            Cells(i, j) = Left(Cells(i, j), InStr(1, Cell, Chr(10)) - 1)
        End If
    Next j
Next i

Answer 3

这很可能不是最简洁的方法，但最终使用@ OldUgly的代码为我工作。

Sub LFtoRow()
Dim myWS As Worksheet, myRng As range
Dim LastRow As Long, iLoop As Long, jLoop As Long
Dim myString() As String

Set myWS = ActiveSheet
LastRow = myWS.Cells(myWS.Rows.count, 1).End(xlUp).row

For iLoop = LastRow To 1 Step -1
    myString = Split(myWS.Cells(iLoop, 1), Chr(10))
    If UBound(myString, 1) > 0 Then
        myWS.Rows(iLoop + 1 & ":" & iLoop + UBound(myString, 1)).Insert shift:=xlShiftDown
        For jLoop = 0 To UBound(myString, 1)
            myWS.Cells(iLoop + jLoop, 1) = myString(jLoop)
        Next jLoop
    End If
Next iLoop

For iLoop = LastRow To 1 Step -1
    myString = Split(myWS.Cells(iLoop, 2), Chr(10))
    If UBound(myString, 1) > 0 Then
        For jLoop = 0 To UBound(myString, 1)
            myWS.Cells(iLoop + jLoop, 2) = myString(jLoop)
        Next jLoop
    End If
Next iLoop

For iLoop = LastRow To 1 Step -1
    myString = Split(myWS.Cells(iLoop, 3), Chr(10))
    If UBound(myString, 1) > 0 Then
        For jLoop = 0 To UBound(myString, 1)
            myWS.Cells(iLoop + jLoop, 3) = myString(jLoop)
        Next jLoop
    End If
Next iLoop

For iLoop = LastRow To 1 Step -1
    myString = Split(myWS.Cells(iLoop, 4), Chr(10))
    If UBound(myString, 1) > 0 Then
        For jLoop = 0 To UBound(myString, 1)
            myWS.Cells(iLoop + jLoop, 4) = myString(jLoop)
        Next jLoop
    End If
Next iLoop

For iLoop = LastRow To 1 Step -1
    myString = Split(myWS.Cells(iLoop, 5), Chr(10))
    If UBound(myString, 1) > 0 Then
        For jLoop = 0 To UBound(myString, 1)
            myWS.Cells(iLoop + jLoop, 5) = myString(jLoop)
        Next jLoop
    End If
Next iLoop

End Sub

是否可以将包含换行符的单元格拆分为一个范围内的多行？

3 个答案: