Массовая замена информации в ячейках [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] при выполнении условия»

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