是否可以使用換行符將單元格拆分爲多個行？

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

這最有可能是沒有做到這一點的最簡潔的方式，但是這結束了我使用@ 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 

Answer 2

我會推薦類似於下面的代碼來解決你的問題。它具有以下屬性：

1. 使用Split函數在Chr（10）上確定每行所需的字符串。 Chr（10）是換行字符。 Split爲你生成一個字符串數組。
2. 爲您插入正確的行數。
3. 從下往上循環遍歷您的範圍，以便處理完整範圍。

代碼...

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 3

這是我的建議，應該處理所有列中的換行符。

另外我刪除了替換，插入一個「;」然後再分裂。完整的代碼將是：

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