Уважаемые форумчане извините если повторяюсь, но решения похожей задачки я найти не смог. Задача в следующем: столбец А1 иногда может содержать значения через запятую и пробел. Хотелось бы макросом производить именно ЗАМЕНУ такой ЯЧЕЙКИ на одно из значений, а также копировать эту строку (целиком) ниже, с последующими значениями ячейки А1. Да, вставлять строку не в конец таблицы, а именно под строку с перечислением.
Уважаемые форумчане извините если повторяюсь, но решения похожей задачки я найти не смог. Задача в следующем: столбец А1 иногда может содержать значения через запятую и пробел. Хотелось бы макросом производить именно ЗАМЕНУ такой ЯЧЕЙКИ на одно из значений, а также копировать эту строку (целиком) ниже, с последующими значениями ячейки А1. Да, вставлять строку не в конец таблицы, а именно под строку с перечислением.ZamoK
Sub ertert() Dim x, y(), i&, j&, k&, v With Range("A1").CurrentRegion x = .Value ReDim y(1 To UBound(x) * 4, 1 To UBound(x, 2)) For i = 1 To UBound(x) For Each v In Split(x(i, 1), ",") k = k + 1 y(k, 1) = Trim(v) For j = 2 To UBound(x, 2) y(k, j) = x(i, j) Next j Next Next i .ClearContents .Resize(k).Value = y() End With End Sub
[/vba]
ZamoK, привет попробуйте: [vba]
Код
Sub ertert() Dim x, y(), i&, j&, k&, v With Range("A1").CurrentRegion x = .Value ReDim y(1 To UBound(x) * 4, 1 To UBound(x, 2)) For i = 1 To UBound(x) For Each v In Split(x(i, 1), ",") k = k + 1 y(k, 1) = Trim(v) For j = 2 To UBound(x, 2) y(k, j) = x(i, j) Next j Next Next i .ClearContents .Resize(k).Value = y() End With End Sub
nilem, Привет Спасибо всё отлично работает, что самое интересное, что у меня в библиотеке лежит похожий код, также с названием "ertert" , но чёрт возьми не вспомнил даже про него
nilem, Привет Спасибо всё отлично работает, что самое интересное, что у меня в библиотеке лежит похожий код, также с названием "ertert" , но чёрт возьми не вспомнил даже про него ZamoK