разбить содержимое ячейки на строки - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)

- - разбить содержимое ячейки на строки (http://forum.oszone.net/showthread.php?t=317149)

blackeangel

25-07-2016 18:41 2654050

разбить содержимое ячейки на строки

Всем привет!
Есть такая задача: необходимо содержимое ячейки транспонировать в столбец.
просто транспонировать не получается, тк надо в один столбец, а при обчычном траспонировании происходит в столбцы
Например, есть

Скрытый текст

3311з-3311ф-3311сл-3311то-3311т-3311км-с9
3311з-3311ф-3311лш-3311сл-3311то-3311т-3311км-с9
3311з-3311т-3311км-с9

надо чтобы записалось в

Скрытый текст

3311з
3311ф
3311сл
3311то
3311т
3311км
с9
3311з
3311ф
3311лш
3311сл
3311то
3311т
3311км
с9
3311з
3311т
3311км
с9

и так далее
то есть в один столбец.
желательно это в макросе сделать

mwz	25-07-2016 20:03 2654076

Цитата:

Цитата blackeangel

то есть в один столбец. »

Именно в один столбец в несколько последовательных ячеек (в зависимости от числа групп, удовлетворяющих условию), а не в столбец внутри единственной ячейки?

blackeangel

25-07-2016 21:14 2654092

mwz, именно.даже если на новый лист, тоже не страшно.

okshef

25-07-2016 23:50 2654118

Данные -> Текст по столбцам -> Разделитель "-" -> Результат скопировать и транспонировать

blackeangel

26-07-2016 07:26 2654139

okshef, по моему, написано по русски, что этот вариант не прокатить, тк при таком проходе образуется куча столбцов, а нужен один.

Iska	26-07-2016 13:54 2654244

blackeangel, образец файла упакуйте в архив и приложите к сообщению.

blackeangel

26-07-2016 21:12 2654338

Iska, пожалуйста, в любом варианте

Iska	27-07-2016 02:13 2654378

blackeangel, пробуйте:

Скрытый текст

Код:

Option Explicit



Sub Sample()

    Dim objRangeSource As Range

    Dim objRangeDest As Range

    Dim strSubstring As Variant

    

    With ThisWorkbook

        With .Worksheets.Add(After:=.Worksheets.Item("Есть"))

            .Name = "Будет"

            Set objRangeDest = .Cells(1, 1)

        End With

        

        For Each objRangeSource In .Worksheets.Item("Есть").UsedRange.Columns.Item(1).Cells

            For Each strSubstring In Split(objRangeSource.Value, "-")

                objRangeDest.Value = strSubstring

                Set objRangeDest = objRangeDest.Offset(1, 0)

            Next

        Next

    End With

End Sub

Время: 22:19.