Sub u_1() Application.ScreenUpdating = False x = Cells(Rows.Count, "e").End(xlUp).Row + 1 Range("e2:e" & x).Clear 'сотрем старое a = Cells(Rows.Count, "b").End(xlUp).Row 'нижняя строка столбца B For b = 2 To a 'цикл от 2й до нижней строки c = Range("b" & b).Value 'значение ячейки d = Replace(c, Chr(10), "") 'уберем символ переноса e = Replace(d, " ", "") 'уберем пробелы f = e & "," 'добавим запятую 'определим кол-во запятых g = Len(f) h = Len(Replace(f, ",", "")) i = g - h For j = 1 To i 'цикл внутри ячейки по кол-ву запятых k = InStr(f, ",") 'ищем запятую l = Left(f, k - 1) 'извлеченный код f = Mid(f, k + 1, g) 'оставшееся в "ячейке" m = Cells(Rows.Count, "e").End(xlUp).Row + 1 'строка очередной записи Range("e" & m) = l Next Next End Sub
[/vba]
[vba]
Код
Sub u_1() Application.ScreenUpdating = False x = Cells(Rows.Count, "e").End(xlUp).Row + 1 Range("e2:e" & x).Clear 'сотрем старое a = Cells(Rows.Count, "b").End(xlUp).Row 'нижняя строка столбца B For b = 2 To a 'цикл от 2й до нижней строки c = Range("b" & b).Value 'значение ячейки d = Replace(c, Chr(10), "") 'уберем символ переноса e = Replace(d, " ", "") 'уберем пробелы f = e & "," 'добавим запятую 'определим кол-во запятых g = Len(f) h = Len(Replace(f, ",", "")) i = g - h For j = 1 To i 'цикл внутри ячейки по кол-ву запятых k = InStr(f, ",") 'ищем запятую l = Left(f, k - 1) 'извлеченный код f = Mid(f, k + 1, g) 'оставшееся в "ячейке" m = Cells(Rows.Count, "e").End(xlUp).Row + 1 'строка очередной записи Range("e" & m) = l Next Next End Sub