Сравнение столбцов и удаление дублей - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д