Здравствуйте уважаемые мастера пера по VBA! Расклад такой (файл прилагается): а) Имеется куча информации в 1 ячейке (сцепление, выборка, список), разделённой разделителем (каламбур). б) Нужно разбить эту ячейку по СТРОКАМ, начиная с выделенной, через ЛЮБОЙ ЗАДАННЫЙ (1, 2, 3 символа) разделитель. (чтобы не пришлось ничего перемещать, заменять и удалять). Желательно: сохранить форматирование исходной ячейки.Мой мозг сгенерировал зловещий план... 1. Я записал рекордером вот такой макрос на основе инструмента "текст по столбцам", и немного исправил, привязав к текущей выделенной ячейке, а не к какой-то конкретной:
Код
Sub TEXTonCOL()
ActiveCell.Select
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=True, Tab:=False, Semicolon _
:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", _
FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End Sub
На этом мои познания в области VBA иссякли и, как видно из кода, макрос по-прежнему привязан к конкретному разделителю "|", так что первая проблема - как сделать, чтобы при запуске макроса вылезал запрос типа "введите символ-разделитель"? Подпроблема: инструмент "текст по столбцам" позволяет ввести только ОДИН символ разделителя, а хотелось хотя бы 3 (разделитель с 2мя пробелами, к примеру). 2. После применения макроса на ячейке, получаю диапазон столбцов (то есть строку) с текстом. (В решении 2 виден очевидный минус - если разделитель отделён пробелами, то они, естественно, никуда не деваются и приходится PLEXом подчищать.) 3. Выделяю этот диапазон, кроме исходной ячейки и транспонирую его специальной вставкой под исходную ячейку. Как видно, способ хоть и увеличивает скорость за счёт макроса, но до рабочего инструмента ой как далеко. Возможно я вообще решил переплыть реку ВДОЛЬ, да ещё и против течения...то есть существует решение гениально простое и совершенно отличное от этого )))) Во вкладке "как надо" приложенного файла на заливку чёрным внимания не обращать - это я так разделил исходные ячейки )))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
получилось что-то не то....вообще как-то странно всё поделилось
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Sub Test()
Dim Delim As String
Dim Str As String
Dim Arr() As String
Dim j As Integer
Delim = InputBox("Введите символ-разделитель")
If Delim = "" Then End
Str = ActiveCell
Arr = Split(Str, Delim)
If UBound(Arr) = 0 Then
MsgBox "Нет в строке такого разделителя"
End
End If
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(UBound(Arr), 0)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For j = 0 To UBound(Arr)
ActiveCell.Offset(j, 0) = Arr(j)
Next j
End Sub
webley, ПРОСТО СУПЕР !!!! 8)ОГРОМНОЕ СПАСИБО !!!! даже вот это " \/ " - 5 знаков !!!! можно сделать разделителем и он поймёт ))))) Единственное, что у меня не получилось разделить это перенос строки Alt+Enter. Пробовал и Ctrl+J, и Alt+010, и =символ(10).Но я им пользуюсь нечасто... P.S.: Посоветуйте что-нибудь по программированию в Excel - хотя бы синтаксис поучить...
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
webley, ОТЛИЧНО, УНИВЕРСАЛЬНО, КОРОТКО, ГЕНИАЛЬНО!!! )))) хоть сейчас в PLEX!!! СПАСИБО БОЛЬШОЕ!!!
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Dima S, большое спасибо за помощь! Наверное я просто неправильно понял Ваш код...
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Ребята, это снова я ))) тогда не протестировал макрос на работу в "умной" таблице. Сейчас вот добрался - выдаёт ошибку "недопустимая операция. была попытка сдвинуть строки таблицы" - есть возможность обмануть или обойти?...
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
попробовал в "умной" таблице - тоже работает. подобный эффект может наблюдаться в случае, если таблица занимает все строки на листе. не в этом ли проблема?
webley, мда...тупанул я маленько )))) спасибо)))) только проблема не в том, что "таблица занимает все строки на листе", а в том, что ячейка, которую мы разбиваем на строки должна быть НЕ ВЫШЕ последней ячейки "умной" таблицы.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
webley, помогите пожалуйста разобраться...что изменить в коде, чтобы при запуске макроса вниз сдвигались не только ячейки, а все задействованные строки???... Вот пример файла как объяснение, почему я так заморачиваюсь... До строки №465 клепал вручную с листа №0.... Разделитель "|"
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
webley, Вы как всегда всё правильно поняли )))) теперь работает в любом месте "умной" таблицы ))))) ОГРОМНОЕ СПАСИБО !!!!! P.S. всё-таки функция достойна включения в PLEX
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Добрый день, уважаемые форумчане! Подскажите пожалуйста, как сделать, чтобы этот макрос работал не только с 1 (активной) ячейкой, но также обрабатывал выделенный простой одномерный массив (столбец). Вроде нужно просто добавить цикл, но не знаю как (((
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
JayBhagavan, получилось вот что (код макроса снизу и он не работает). Походу делает он вот что: запрашивает символ разделитель и разбивает первую ячейку из диапазона как надо, но после разбивки Selection охватывает только УЖЕ РАЗБИТЫЕ строки первой ячейки. Затем макрос опять запрашивает разделитель (хотя имеется ввиду, что в диапазоне для разбивки каждой ячейки используется один и тот же разделитель (иначе нет смысла менять макрос). Прикрепляю образец файла с пояснениями, буду рад если поможете. Спасибо за участие!
Код
Sub TextOnRows()
Dim cl As Range
If TypeName(Selection) = "Range" Then
For Each cl In Selection
Dim Delim As String
Dim Str As String
Dim arr() As String
Dim j As Integer
Delim = InputBox("Введите символ-разделитель")
If Delim = "перенос" Then Delim = Chr(10)
If Delim = "" Then End
Str = ActiveCell
arr = Split(Str, Delim)
If UBound(arr) = 0 Then
MsgBox "Нет в строке такого разделителя"
End
End If
Rows(ActiveCell.Offset(1, 0).Row & ":" & ActiveCell.Offset(UBound(arr), 0).Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For j = 0 To UBound(arr)
ActiveCell.Offset(j, 0) = arr(j)
Next j
Next cl
End If
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
JayBhagavan, простите, но разве без этого не обойтись??? У нас есть InputBox, в котором мы единожды для диапазона указываем разделитель, у нас есть макрос, который разбивает всё как надо для одной ячейки. Подскажите просто как сделать цикл типа этого (этот не работает ). Я тут хотел сделать следующее: добавить диапазон xRng, равный выделенному диапазону с началом в первой (верхней) ячейке (разумеется). Запускается цикл...1. проверка на наличие указанного разделителя в первой ячейке, если нет - пропускаем и берём следующую ячейку в диапазоне, если есть - разбиваем по всем правилам исходного макроса от Webley, затем берём следующую ячейку диапазона (тут как-то нужно определять следующую ячейку, чтобы не путать с уже разбитыми, наверное перед запуском цикла). Вот как-то так... Если нет желания/возможности возиться с таким вариантом, подскажите путь реализации своего видения решения данной проблемы. Заранее спасибо!
Код
Sub TextOnRows()
Dim Delim As String
Dim Str As String
Dim arr() As String
Dim j As Integer
Delim = InputBox("Введите символ-разделитель")
If Delim = "перенос" Then Delim = Chr(10)
If Delim = "" Then End
i = 1
Set xRng = Selection
For xCounter = 1 To xRng.Rows.Count
arr = Split(xCounter, Delim)
If UBound(arr) = 0 Then i = i + 1
Else
Rows(xCounter.Offset(1, 0).Row & ":" & xCounter.Offset(UBound(arr), 0).Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
For j = 0 To UBound(arr)
xCounter.Offset(j, 0) = arr(j)
Next j
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack_Famous, внимательней прочтите свой код из №18. Зачем в цикл пихать запрос на разделитель и объявление переменных??? При чём тут активная ячейка, если работаем с переменной cl. Сместите 4ю строку перед 16й. Уберите Str и ActiveCell и замените их на cl. Если я где-то ошибся, то пользуйтесь отладкой и вникайте в код.
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
JayBhagavan, а если в диапазоне присутствуют ячейки, не нуждающиеся в обработке?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
JayBhagavan, насчёт переменного разделителя не принципиально. Вот изменённый код для разделителя "перенос строки внутри ячейки". Выполняется до ошибки на всё количество строк 1 столбца... Я не понимаю, что нужно сделать(((( практически совсем не разбираюсь в VBA
Код
Sub TextOnRows()
Dim cl As Range
If TypeName(Selection) = "Range" Then
Dim arr() As String
Dim j As Integer
For Each cl In Selection
arr = Split(cl, Chr(10))
Rows(cl.Offset(1, 0).Row & ":" & cl.Offset(UBound(arr), 0).Row).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For j = 0 To UBound(arr)
cl.Offset(j, 0) = arr(j)
Next j
Next cl
End If
End Sub
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Файл ещё раз прикрепил. Там вроде бы всё понятно... Если коротко - есть полностью рабочий макрос, который работает только с 1 ячейкой, а именно разбивает ячейку вниз через указанный символ-разделитель, при этом делает это, вставляя строки (сдвигает вниз). Если в ячейке такого разделителя нет, то выводит сообщение об ошибке. Всё, что нужно изменить - добавить цикл выполнения данного макроса по выделенному диапазону (при том, что разделитель в диапазоне одинаковый). При этом нужно будет заменить проверку: теперь, если в ячейке отсутствует указанный разделитель - брать следующую ячейку.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
...нашёл подобное в надстройке MULTEX у Дмитрия Щербакова
не работает ДАННЫМ образом, а просто, что называется, "в лоб" разносит по строкам, не вставляя строки...
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Option Explicit
Sub jjj()
Dim cl As Range, rng As Range, rngTmp As Range
Dim strDelim$, strTmp$
Dim Arr() As String
Dim i&, n&, j&, k&
strDelim = InputBox("Введите символ-разделитель")
If strDelim = "перенос" Then strDelim = Chr(10)
If strDelim = "" Then End
If TypeName(Selection) = "Range" Then
Set rng = Selection
n = rng.Rows.Count
For i = n To 1 Step -1
With rng(i, 1)
strTmp = .Value & strDelim
Arr = Split(strTmp, strDelim)
j = UBound(Arr, 1) - 1
If j > 0 Then
.Offset(1).Resize(j).EntireRow.Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
Set rngTmp = .Resize(j + 1)
For k = 0 To j
rngTmp(k + 1, 1).Value = Arr(k)
Next k
End If
End With
Next i
End If
End Sub
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
JayBhagavan, Браво! Просто замечательно! ))))) В точности, как и задумывалось - вам удалось даже сохранить возможность менять разделитель, не влезая в код, что очень универсально (буду пытаться разобраться в коде - как)! Огромное вам спасибо - вы очень помогли!!!! P.S.: отдельное спасибо модератору vikttur за коррекцию моих корявых мыслей на сайте)))))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄