Сравнение столбцов и удаление дублей - VBA

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

Добрый вечер! Имеется excel файл напечатанного ниже формата:

Столбец "A"

- Имеющиеся артикула;

Столбец "B"

- Артикула которых возможно нет;

Столбцы "С и до конца"

- Дополнительная информация относящаяся к столбцу

"B"

. 1. Напишите пожалуйста макрос который проверит наличие одинаковых значений между ячейками

столбцов "A" и "B"

; 1.1. Если в ячейке

столбца "B"

, нашлось значение равное значению ячейки

столбца "A"

, - следует удалить строку

Столбца "B"

, - содержащую это повторяющееся значение. Пример файла во вложении, в нем представлена страница

"Исходник"

и страница

"Необходимый результат"

. Ниже печатаю пример, страницы исходник: 1. [A] Имеющиеся артикула [B] Артикула которых возможно нет [C] Дополнительная информация 1 [D] Дополнительная информация 2 [E] Дополнительная информация 3 2. [A] 111 [B] 111 [C] [D] [E] 555 3. [A] 222 [B] 222 [C] 2 [D] [E] 4. [A] 444 [B] 333 [C] 678 [D] [E] 5. [A] 555 [B] 666 [C] [D] [E] 6. [A] 666 [B] 999 [C] [D] [E] 991 Ниже печатаю пример, страницы необходимый результат: 1. [A] Имеющиеся артикула [B] Артикула которых возможно нет [C] Дополнительная информация 1 [D] Дополнительная информация 2 [E] Дополнительная информация 3 4. [A] 444 [B] 333 [C] 678 [D] [E] 6. [A] 666 [B] 999 [C] [D] [E] 991

Решение задачи: «Сравнение столбцов и удаление дублей»

textual
                            Листинг программы 
                        
 
                        
                          
                    
Sub DelReplyA()
    Dim c&(), rn As Range
    With ActiveSheet
        a = .UsedRange.Columns(1)
        b = .UsedRange.Columns(2)
        k = .UsedRange.Columns.Count + 1
    End With
    ReDim c(1 To UBound(b, 1), 1 To 1)
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a)
            .Item(a(i, 1)) = i
        Next
        For i = 2 To UBound(b)
            If .exists(b(i, 1)) Then c(i, 1) = 1
        Next
    End With
    Cells(1, k).Resize(UBound(c), 1) = c
    Set rn = Range(Cells(1, k), Cells(1, k))
    Columns(k).ColumnDifferences(rn).EntireRow.Delete
    Columns(k).Delete
End Sub