Копирование строки по условию

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строки по условию (Макросы/Sub)

ZamoK

Дата: Вторник, 27.06.2017, 10:52 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 268

Репутация: 4 ±

Замечаний: 0% ±

Excel 2003-2016

Уважаемые форумчане извините если повторяюсь, но решения похожей задачки я найти не смог.
Задача в следующем: столбец А1 иногда может содержать значения через запятую и пробел. Хотелось бы макросом производить именно ЗАМЕНУ такой ЯЧЕЙКИ на одно из значений, а также копировать эту строку (целиком) ниже, с последующими значениями ячейки А1.
Да, вставлять строку не в конец таблицы, а именно под строку с перечислением.

К сообщению приложен файл: 999.xls (15.0 Kb)

Я не Гуру, но стремлюсь!

Ответить

nilem

Дата: Вторник, 27.06.2017, 11:22 | Сообщение № 2

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

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

[/vba]