Разделить текст в ячейках при разрывах строки

Question

Я работаю над таблицей 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 

Я искал на форумах подобного кода, но у меня возникли проблемы адаптации для моей собственной цели.

UPDATE: Не уверен, почему именно это было закрыто, предположим, что вам, возможно, нужен пример какого-то кода. Я использовал ниже макрос, который я нашел в интернете:

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

у меня были некоторые вопросы, получить Казимеж код работать, пока не указано, какой именно лист следует таргетирования. Мой сценарий был многостраничным, и через некоторое исследование я обнаружил, что код фокусировался на других листах во втором вложенном цикле - по неизвестной причине. Если код не работает для вас, я предлагаю попробовать следующий фрагмент.

В строке 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

Вышеуказанные макросы не работают для меня. Я попробовал простой способ, основанный на макросах. Для нашего примера предположим, что у вас есть только два столбца A и B. B имеет ваш контент с символом новой строки.

1. Разделение во второй колонке (колонка В) на основе новой строки в до нескольких столбцов и дать специальный ограничитель CTRL + J (Данные -> Текст в Столбцы)
2. Копирование столбца A, B и вставить в другой лист в колонке A, B нового листа.
3. Скопируйте столбцы A, C и вставьте пасту ниже первого набора данных в столбце A, B нового листа.
4. Повторите это, пока столбец на оригинальном листе не имеет данных.
5. В новом листе удалите все строки, где столбец B пуст.