Массовая замена информации в ячейках [D:BL] при выполнении условия - VBA

Формулировка задачи:

Добрый день! Имеется excel файл, в оригинальном файле заполнено 50 тыс. строк x 83 столбцов (количество заполненных столбцов меняется, может быть как больше так и меньше), для примера прикладываю образец во вложении (пример исходного файла на листе 1). Содержание столбцов:Столбец "A" - содержит артикул (эта информация используется для понимания, к какому элементу относится информация на строке) - тобишь артикул должен остаться рядом с элементами в с которыми и был изначально;Столбец "B" - этот текст будет встречаться в ячейках столбцов "D:BL", этот текст необходимо найти и заменить на тот, который в ячейках столбца "C"Столбец "C" - этот текст должен находится в ячейках столбцов "D:BL", вместо текста который мы видим в ячейках столбца "B".Столбцы "D:BL" - основная информация в которой необходимо найти и заменить содержание, заменяем информацией со столбца "C", в свою очередь столбец "C" привязан к столбцу "B". Для более ясного понимания, значения ячейки "B1" дополняет значение ячейки "C1"... тобишь - значение ячейки "B1" ищет совпадение в ячейках столбцов "D50000:BL50000", а после нахождения совпадения, заменяет его на информацию из ячейки "C1", значение ячейки "B2" ищет совпадение в ячейках столбцов "D50000:BL50000", а после нахождения совпадения, заменяет его на информацию из ячейки "C2" и т. д. Напишите пожалуйста макрос который будет выполнять замену значений по условию которое я напечатал выше. Пример исходного файла и необходимый результат прикрепляю в файле во вложении.

Код к задаче: «Массовая замена информации в ячейках [D:BL] при выполнении условия - VBA»

textual
Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 29.06.2016 (Александр)
'
Dim m(), rz As Range, lr, li, r
With ActiveSheet
    li = Cells(Rows.Count, 2).End(xlUp).Row
    lr = .UsedRange.Rows.Count
     m() = .Range("B1").Resize(li, 2).Value
    Set rz = .Range("D1:BL" & lr)
    For r = 1 To UBound(m)
        rz.Replace What:=m(r, 1), Replacement:= _
        m(r, 2), LookAt:=xlPart, SearchOrder:=xlByRows, _
        MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next r
End With
End Sub

6   голосов, оценка 4.000 из 5


СОХРАНИТЬ ССЫЛКУ