Страницы: 1
RSS
Разбивка многострочных ячеек на строки
 
Приветствую!
Требуется разделить ячейки с несколькими значениями, с переносом, на строки.
Пример во вложении. Первая таблица с данными, вторая то к чему их нужно привести.
По сути там нужно сделать просто сдвиг значений вниз. Может у кого-то есть готовое решение или макрос для этого.
Заранее благодарен!
 
Несколько дней назад была подобная тема...
 
Цитата
Михаил Витальевич С. написал:
Несколько дней назад была подобная тема...
Шикарно:)

MMAXX95, Гляньте сообщения форума за несколько дней, там найдёте)
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Dyroff, ну понимаете... задача простая, но писанины много и решать лично мне ее не интересно - я такие решал уже много раз.
А подобная тема действительно была.

зы. Поиском можно поискать.
Изменено: Михаил Витальевич С. - 07.12.2019 00:51:14
 
Михаил Витальевич С., Да конечно понимаю, Михаил) Это же ирония. Я просто представил себя на месте автора вопроса.
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
К сожалению, ничего подходящего не нашел :(
 
MMAXX95,
На Лист1 удалите строки с Образец и ниже
Код
Sub RazdelitStroki()
Dim i As Long
Dim iLastRow As Long
Dim n As Long
Dim arr_M
Dim arr_O
Dim arr_P
Dim arr_Q
    iLastRow = Cells(Rows.Count, "M").End(xlUp).Row
    For i = iLastRow To 2 Step -1
      If InStr(1, Cells(i, "M"), Chr(10)) > 0 Then
        arr_M = Split(Cells(i, "M"), Chr(10))
        arr_O = Split(Cells(i, "O"), Chr(10))
        arr_P = Split(Cells(i, "P"), Chr(10))
        arr_Q = Split(Cells(i, "Q"), Chr(10))
        Cells(i, "M") = arr_M(0)
        Cells(i, "O") = arr_O(0)
        Cells(i, "P") = arr_P(0)
        Cells(i, "Q") = arr_Q(0)
        For n = 1 To UBound(arr_M)
          Rows(i + n).Insert
          Cells(i + n, "M") = arr_M(n)
          Cells(i + n, "O") = arr_O(n)
          Cells(i + n, "P") = arr_P(n)
          Cells(i + n, "Q") = arr_Q(n)
        Next
          Range("J" & i).Resize(UBound(arr_M) + 1).FillDown
          Range("K" & i).Resize(UBound(arr_M) + 1).FillDown
      End If
    Next
End Sub
 
Kuzmich, то что надо! Большое Вам спасибо!!!
Страницы: 1
Наверх