Здравствуйте, прошу помочь. Есть таблица состоящая из 4 столбцов и более 1000 строк. Каждая ячейка 4 столбца содержит разное кол-во числовых значений разделенных запятой. Нужно после каждой строки вставить ее копию столько раз, сколько значений в ячейке 4, при этом в исходной строке в ячейке 4 оставить первое значение, во второй только второе, в третьей - третье и т.д. Если в строке забито одно значение, то соответственно ни чего копировать не надо и переходим на след строчку. И так надо преобразовать весь массив. Пример: 1.2.3 ......4...... (4 столбца) А Б П 12,48,135 С Р Б 1236,4568
Конечный результат 1 2 3 4
А Б П 12 А Б П 48 А Б П 135 С Р Б 1236 С Р Б 4568 [moder]Читаем правила форума. Прикладываем свой пример в Excel
Здравствуйте, прошу помочь. Есть таблица состоящая из 4 столбцов и более 1000 строк. Каждая ячейка 4 столбца содержит разное кол-во числовых значений разделенных запятой. Нужно после каждой строки вставить ее копию столько раз, сколько значений в ячейке 4, при этом в исходной строке в ячейке 4 оставить первое значение, во второй только второе, в третьей - третье и т.д. Если в строке забито одно значение, то соответственно ни чего копировать не надо и переходим на след строчку. И так надо преобразовать весь массив. Пример: 1.2.3 ......4...... (4 столбца) А Б П 12,48,135 С Р Б 1236,4568
Конечный результат 1 2 3 4
А Б П 12 А Б П 48 А Б П 135 С Р Б 1236 С Р Б 4568 [moder]Читаем правила форума. Прикладываем свой пример в ExcelГость
К сожалению не подходит, задача состоит в том что бы скопировать строку столько раз в низ сколько значений в 4 ячейке, при этом оставить только одно значение. Конечно можно разбить 4 столбец на отдельные, но потом вручную опять таки копировать строки и убирать лишние значения. Когда таблица состоит из 100 строк, то это можно сделать, а когда 500-1000 то уже проблематично.
К сожалению не подходит, задача состоит в том что бы скопировать строку столько раз в низ сколько значений в 4 ячейке, при этом оставить только одно значение. Конечно можно разбить 4 столбец на отдельные, но потом вручную опять таки копировать строки и убирать лишние значения. Когда таблица состоит из 100 строк, то это можно сделать, а когда 500-1000 то уже проблематично.Svetik
Sub Мяу() Dim arr, i&, k&, j& arr = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value For i = UBound(arr) To 1 Step -1 If InStr(arr(i, 1), ",") Then For j = 1 To Len(arr(i, 1)) If Mid$(arr(i, 1), j, 1) = "," Then k = k + 1 End If Next Rows(i).Copy Rows(i & ":" & i + k - 1).Insert Shift:=xlDown k = 0 End If Next arr = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value On Error Resume Next For i = 1 To UBound(arr) If InStr(arr(i, 1), ",") Then arr(i + 1, 1) = Mid$(arr(i, 1), InStr(arr(i, 1), ",") + 1) arr(i, 1) = Left$(arr(i, 1), InStr(arr(i, 1), ",") - 1) End If Next Range("D1").Resize(UBound(arr)) = arr End Sub
[/vba]
[vba]
Код
Sub Мяу() Dim arr, i&, k&, j& arr = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value For i = UBound(arr) To 1 Step -1 If InStr(arr(i, 1), ",") Then For j = 1 To Len(arr(i, 1)) If Mid$(arr(i, 1), j, 1) = "," Then k = k + 1 End If Next Rows(i).Copy Rows(i & ":" & i + k - 1).Insert Shift:=xlDown k = 0 End If Next arr = Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value On Error Resume Next For i = 1 To UBound(arr) If InStr(arr(i, 1), ",") Then arr(i + 1, 1) = Mid$(arr(i, 1), InStr(arr(i, 1), ",") + 1) arr(i, 1) = Left$(arr(i, 1), InStr(arr(i, 1), ",") - 1) End If Next Range("D1").Resize(UBound(arr)) = arr End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
