换行符中的单元格中的文本

我正在处理一个Excel电子表格，其中有39列的数据。 其中一列AJ列是描述字段，并包含详细描述行项目的文本。 单元格内部的这段文字有时会长于一行，并且按（ALT + Enter）键开始新行。

我需要能够复制整个工作表并将其全部放在另一个工作表（现有工作表）中，但AJ列中每个新行的新行如下所示：

Column A Column B Column AJ Electrical Lighting This is line one of the text And in the same cell on a new line 

这是所需的结果：

 Column A Column B Column AJ Electrical Lighting This is line one of the text Electrical Lighting And in the same cell on a new line 

我已经search了类似的代码论坛，但我无法适应自己的目的。

更新：不确定为什么这已被closures，假设你可能想要一个代码的例子。 我正在使用下面的macros，我发现在互联网上：

 Sub Splt() Dim LR As Long, i As Long Dim X As Variant Application.ScreenUpdating = False LR = Range("AJ" & Rows.Count).End(xlUp).Row Columns("AJ").Insert For i = LR To 1 Step -1 With Range("B" & i) If InStr(.Value, ",") = 0 Then .Offset(, -1).Value = .Value Else X = Split(.Value, ",") .Offset(1).Resize(UBound(X)).EntireRow.Insert .Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X) End If End With Next i Columns("AK").Delete LR = Range("AJ" & Rows.Count).End(xlUp).Row With Range("AJ1:AK" & LR) On Error Resume Next .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" On Error GoTo 0 .Value = .Value End With Application.ScreenUpdating = True End Sub 

但它不工作，也许我错误地适应了它。

Answer 1

试试这个代码：

 Sub JustDoIt() 'working for active sheet 'copy to the end of sheets collection ActiveSheet.Copy after:=Sheets(Sheets.Count) Dim tmpArr As Variant Dim Cell As Range For Each Cell In Range("AJ1", Range("AJ2").End(xlDown)) If InStr(1, Cell, Chr(10)) <> 0 Then tmpArr = Split(Cell, Chr(10)) Cell.EntireRow.Copy Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _ EntireRow.Insert xlShiftDown Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr) End If Next Application.CutCopyMode = False End Sub 

之前 —————————————– 之后

Answer 2

我有一些问题得到Kazimierz代码工作，直到我确切指定了它应该是目标的工作表。 我的场景是一个多页安排，通过一些调查，我发现代码集中在第二个嵌套循环中的其他表 – 原因不明。 如果代码不适合你，我build议尝试下面的代码片段。

在Set mtd = Sheets("SplitMethod")中将名称更改为源表的名称。 将下一行中的B1和B2更改为目标列，并保留1和2。 这假定您的列在第1行中有一个标题。如果没有标题，请将B2更改为B1。

 Sub JustDoIt() 'working for active sheet 'copy to the end of sheets collection Worksheets("SplitMethod").Activate ActiveSheet.Copy after:=Sheets(Sheets.Count) Dim tmpArr As Variant Dim Cell As Range Dim mtd As Worksheet Set mtd = Sheets("SplitMethod") For Each Cell In mtd.Range("B1", mtd.Range("B2").End(xlDown)) If InStr(1, Cell, Chr(10)) <> 0 Then tmpArr = Split(Cell, Chr(10)) Cell.EntireRow.Copy Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _ EntireRow.Insert xlShiftDown Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr) End If Next Application.CutCopyMode = False End Sub 

Answer 3

上面的macros没有为我工作。 我尝试了一个简单的非基于macros的方式来做到这一点。 对于我们的例子，让我们假设你只有两列A和B. B有你的内容与换行符。

1. 将基于换行符的第二列（列B）拆分为多列，并给出特殊的分隔符CTRL + J（数据 – >文本到列）
2. 复制列A，B并粘贴到新工作表A，B列中的不同工作表中。
3. 复制列A，C，并粘贴到第一组数据的下方，在新表的A，B列中。
4. 重复此操作，直到原始工作表中的列没有任何数据。
5. 在新工作表中，删除列B为空的所有行。