VBA, преобразовать ячейки с несколькими абзацами текста -> разделить абзацы на новые ячейки
У меня есть таблица с такими данными:Обзорное изображение таблицы
В столбце «А» у меня есть несколько ячеек, содержащих несколько абзацев. В идеале моя цель — разбить каждую ячейку на несколько ячеек ниже (или строк ниже), разделенных абзацами. Моя проблема заключается в том, что под каждым существующим набором данных столбца «A» уже есть данные. Поэтому нам нужно будет вставить произвольное количество строк, определенное существующими абзацами, а затем транспонировать вниз. В идеале я бы настроил это VBA; но формула тоже подойдет.
Конечная цель: Конечная цель
Если кто-нибудь может помочь с решением, буду очень признателен.
Что я пробовал:
- Вставка нескольких новых столбцов после столбца «А» — проблема в том, что вы не уверены в количестве необходимых новых столбцов, поскольку количество абзацев в ячейке может варьироваться. Одним из решений этой проблемы является копирование столбца «А» на новый лист и работа с ним. 2) Функция «Текст в столбцы» — (я бы хотела, чтобы вместо этого в Excel был текст в строках) -> Разделяется «Другое» -> «CTRL + J» (разрывы строк) -> Готово; ЗАТЕМ: Вставьте строки ниже и ТРАНСПОНИРУЙТЕ вниз.
У меня есть VBA для преобразования текста в столбцы, но мне нужны более высокие знания.
Sub Delimit()
'splits Text active cell using ALT+10 char
Dim splitVals As Variant
Dim totalVals As Long
Dim i As Integer
For i = 1 To 1000
splitVals = Split(ActiveCell.Value, Chr(10))
totalVals = UBound(splitVals)
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals
ActiveCell.Offset(1, 0).Activate
Next i
End Sub
Не знаете, как применить это к диапазону всех ячеек в столбце «А» с текстом, а затем добавить необходимые строки ниже исходных строк для достижения цели.
Ответы 1
Вы можете попробовать это:
Sub test()
Dim inputrange As Range, textarray
Set inputrange = ActiveSheet.Range("A1:A1000") 'alter this to suit
textarray = Split(Application.WorksheetFunction. _
TextJoin(Chr(10), True, inputrange), Chr(10))
inputrange.End(xlDown).Resize _
(1 + UBound(textarray) - inputrange.Rows.Count).EntireRow.Insert (xlDown)
inputrange.Cells(1).Resize(1 + UBound(textarray), 1).Value = _
WorksheetFunction.Transpose(textarray)
End Sub
А вот вторая версия, позволяющая обойти ограничение длины TextJoin в 32 КБ:
Sub test_v2()
Dim inputrange As Range, c As Range, textarray, StrText As String
Set inputrange = ActiveSheet.Range("A1:A1000")
For Each c In inputrange
StrText = StrText & c.Value & Chr(10)
Next
textarray = Split(StrText, Chr(10))
inputrange.End(xlDown).Resize _
(1 + UBound(textarray) - inputrange.Rows.Count).EntireRow.Insert (xlDown)
inputrange.Cells(1).Resize(1 + UBound(textarray), 1).Value = _
WorksheetFunction.Transpose(textarray)
End Sub
Всего у вас должно быть более 32 тыс. текста. Вместо этого это нужно будет записать в виде цикла. Позвольте мне поработать над v2.
Я добавил вторую версию скрипта, которая сможет справиться с большими объемами текста.
Я также добавил строку для смещения строк вниз, чтобы избежать перезаписи.
Знаете ли вы, есть ли способ скопировать данные каждой строки? Теперь, когда мы разбили каждый абзац или разрыв строки, оставшиеся столбцы с пустыми ячейками было бы полезно скопировать их данные в соответствующие новые строки.
После добавления указанного целевого диапазона; Я получаю сообщение об ошибке: 1004: невозможно получить свойство TextJoin класса функции рабочего листа» -> эта ошибка отмечается в «строке текстового массива» вашего кода.