Обход ограничения \\ Каждое слово в отдельной СТРОКЕ

Пользователь

Сообщений: 70 Регистрация: 17.05.2016

09.09.2017 11:15:37

Стандартная функция Excel "Заполнить" > "Выровнять" (она же в VBA: "Selection.Justify") работает только с первыми 255 символами в ячейке, как и множество других подлых функций (например, "СЧЁТЕСЛИ").

Возможно ли обойти это ограничение?
Возможно ли написать пользовательскую функцию?
Может есть вообще другой способ?

Задача: преобразовать текст в ячейке таким образом, чтобы рядом с ним создалось количество строк, равное количеству слов в ячейке (по факту - количеству пробелов между словами, +1).
Чтобы у каждого слова из первоначальной ячейки была своя собственная строка. Вот так:
Чтобы
у
каждого
слова
из
первоначальной
ячейки
была
своя
собственная
строка.
Вот
так:

(а потом я ещё всякие символы лишние, вроде ":" и "." убираю).
"Текст по столбцам" не предлагать.
Спасибо.

Прикрепленные файлы

42.xlsx (8.4 КБ)

Изменено: RazorBaze - 09.09.2017 11:24:43 (Прикреплён файл примера.)

vikttur Пользователь Сообщений: 47199 Регистрация: 15.09.2012	#2 09.09.2017 11:30:02 =СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(" "&$A$2;" ";ПОВТОР(" ";99));СТРОКА(A1)*99;99))

RazorBaze Пользователь Сообщений: 70 Регистрация: 17.05.2016	#3 09.09.2017 11:38:27 Ок, благодарю. А можно в VBA?

kuklp

Пользователь

Сообщений: 14868 Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

09.09.2017 11:45:32

Код

Public Sub www()
    Dim lr&, a, i&
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = lr To 2 Step -1
    If InStr(Cells(i, 1), " ") Then' на случай если нечего делить
        a = Split(Cells(i, 1), " ")
        Cells(i, 1).Resize(UBound(a)).Insert xlDown
        Cells(i, 1).Resize(UBound(a) + 1).Value = Application.Transpose(a)
        End If
    Next
End Sub

Изменено: kuklp - 09.09.2017 11:49:58

Я сам - дурнее всякого примера! ...

RazorBaze Пользователь Сообщений: 70 Регистрация: 17.05.2016	#5 09.09.2017 11:59:13 Товарищ kuklp, вообще шикарно Вот только бы оно работало для "Selection" (любой выбранной ячейки) - ???!!1

kuklp

Пользователь

Сообщений: 14868 Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

09.09.2017 12:11:15

Код

Public Sub www()
    Dim a
    If InStr(Selection, " ") = 0 Or Selection.Cells.Count > 1 Then Exit Sub
    a = Split(Selection, " ")
    Selection.Resize(UBound(a)).Insert xlDown
    Selection.Resize(UBound(a) + 1).Value = Application.Transpose(a)
End Sub

Я сам - дурнее всякого примера! ...

RazorBaze Пользователь Сообщений: 70 Регистрация: 17.05.2016	#7 09.09.2017 12:20:23 большое ОГРОМНОЕ С П А С И Б О )))