Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование строки по условию - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строки по условию (Макросы/Sub)
Копирование строки по условию
ZamoK Дата: Вторник, 27.06.2017, 10:52 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

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


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

Автор - ZamoK
Дата добавления - 27.06.2017 в 10:52
nilem Дата: Вторник, 27.06.2017, 11:22 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1329
Репутация: 471 ±
Замечаний: 0% ±

Excel 2013
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]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщение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]

Автор - nilem
Дата добавления - 27.06.2017 в 11:22
ZamoK Дата: Вторник, 27.06.2017, 12:09 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
nilem, Привет
Спасибо всё отлично работает, что самое интересное, что у меня в библиотеке лежит похожий код, также с названием "ertert" :D , но чёрт возьми не вспомнил даже про него %)


Я не Гуру, но стремлюсь!
 
Ответить
Сообщениеnilem, Привет
Спасибо всё отлично работает, что самое интересное, что у меня в библиотеке лежит похожий код, также с названием "ertert" :D , но чёрт возьми не вспомнил даже про него %)

Автор - ZamoK
Дата добавления - 27.06.2017 в 12:09
nilem Дата: Вторник, 27.06.2017, 12:56 | Сообщение № 4
Группа: Авторы
Ранг: Старожил
Сообщений: 1329
Репутация: 471 ±
Замечаний: 0% ±

Excel 2013
Да, все ertert'ы чем-то похожи :)


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеДа, все ertert'ы чем-то похожи :)

Автор - nilem
Дата добавления - 27.06.2017 в 12:56
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строки по условию (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!