Разбить текст ячейки (строки), содержащий разделитель, на строки макросом

@Фишка · Регистрация: 21.07.2015

Author24 — интернет-сервис помощи студентам

Необходимо разбить текст в ячейке (с разделителями "Alt+Enter") на отдельные строки

@Vlad999 · 21.07.2015, 16:03

вот код, пробуйте на черновике т.к. знания начальные, могу что то упустить, не учесть.

Visual Basic

Sub vvv()
Dim i#, mas(), s, k#, j#, R#
Application.ScreenUpdating = False 'отключаем обновление экрана
R = Cells(Rows.Count, 1).End(xlUp).Row
For i = R To 2 Step -1
   s = Split(Cells(i, 1), Chr(10))
   If UBound(s) > 0 Then
     ReDim mas(1 To UBound(s) + 1, 1 To 6)
     For j = 1 To 6
         For k = 1 To UBound(s) + 1
         mas(k, j) = Split(Cells(i, j), Chr(10))(k - 1)
         Next
     Next
   Cells(i, 1).Resize(UBound(s), 1).EntireRow.Insert
   Cells(i, 1).Resize(UBound(mas), UBound(mas, 2)) = mas
   End If
Next
Application.ScreenUpdating = True
End Sub

@Фишка · 21.07.2015, 16:50 **[ТС]**

Спасибо, Vlad999!
....ничего у меня не получилось, т.к. я не программист, а просто пользователь.
макросы для меня - темный лес!

Добавлено через 8 минут
Слушайте, Vlad999, вот я балда

, всё получилось - и у Вас и у меня, я просто не заметила, как всё сработало

.
Всё работает - спасибо!!!

А то, я уж собралась делать всё обходными путями - через Word - копируешь в Word, а потом обратно в Excel - и всё разносится по строкам ))))))

@h8ga4nm1 · 05.09.2019, 12:06

Добрый день, Vlad999, подскажите, при запуске макроса выдаёт ошибку

"subscript out of range error 9"
на строке
mas(k, j) = Split(Cells(i, j), Chr(10))(k - 1)

Можете модифицировать код, чтобы результат был, как на скриншоте? (Сверху исходный текст, снизу необходимый результат?)

P.s. количество строк может варьироваться до 20

@h8ga4nm1 · 05.09.2019, 12:12

upd. изменил название файла на vvv ошибка пропала. Но при запуске макроса ничего не происходит.

@Vlad999 · 05.09.2019, 12:26

файл показываем.

@h8ga4nm1 · 05.09.2019, 13:23

вот файл.

@h8ga4nm1 · 06.09.2019, 18:46

Может кому пригодится
Необходимый столбец указывается в строке 5 (В данном случае столбец D)

После символа Chr(10) (ALT+ENTER) будет создана новая строка. При необходимости исправить на свой символ в строке 6

Исходный текст и необходимый результат видны в комментарии

Код макроса

Кликните здесь для просмотра всего текста

Visual Basic

Sub NewRows()
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Dim tmpArr As Variant
    Dim Cell As Range
    For Each Cell In Range("D1", Range("D2").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

@Фишка 0 / 0 / 0 Регистрация: 21.07.2015 Сообщений: 7
		1
	Разбить текст ячейки (строки), содержащий разделитель, на строки макросом 21.07.2015, 13:18. Показов 15305. Ответов 7 Метки нет (Все метки) Необходимо разбить текст в ячейке (с разделителями "Alt+Enter") на отдельные строки 0

@Фишка 0 / 0 / 0 Регистрация: 21.07.2015 Сообщений: 7
	21.07.2015, 16:50 [ТС]	3
	Спасибо, Vlad999! ....ничего у меня не получилось, т.к. я не программист, а просто пользователь. макросы для меня - темный лес! Добавлено через 8 минут Слушайте, Vlad999, вот я балда , всё получилось - и у Вас и у меня, я просто не заметила, как всё сработало . Всё работает - спасибо!!! А то, я уж собралась делать всё обходными путями - через Word - копируешь в Word, а потом обратно в Excel - и всё разносится по строкам )))))) 0

@h8ga4nm1 0 / 0 / 0 Регистрация: 29.12.2015 Сообщений: 15
	05.09.2019, 12:06	4
	Добрый день, Vlad999, подскажите, при запуске макроса выдаёт ошибку "subscript out of range error 9" на строке mas(k, j) = Split(Cells(i, j), Chr(10))(k - 1) Можете модифицировать код, чтобы результат был, как на скриншоте? (Сверху исходный текст, снизу необходимый результат?) P.s. количество строк может варьироваться до 20 Миниатюры 0

@h8ga4nm1 0 / 0 / 0 Регистрация: 29.12.2015 Сообщений: 15
	05.09.2019, 12:12	5
	upd. изменил название файла на vvv ошибка пропала. Но при запуске макроса ничего не происходит. 0

@Vlad999 3897 / 2302 / 776 Регистрация: 02.11.2012 Сообщений: 6,119
	05.09.2019, 12:26	6
	файл показываем. 0

	06.09.2019, 18:46

Разбить текст ячейки (строки), содержащий разделитель, на строки макросом

Решение