Поиск повторяющихся записей - VBA
Формулировка задачи:
Добрый день.
Нужна Ваша помощь. Имеется файл, на двух разных листах содержатся записи и надо найти повторяющиеся элементы, выставить пометки да/нет. Да, если запись повторяется, нет, если запись не повторяется. Проблема возникла в самом выводе пометок. Не судите строго, изучаю второй день VBA.
Cells(i, 6).Select
ActiveCell.FormulaR1C1 = " = IF ((A1=A2) AND (B1=B2) AND (C1=C2) AND (D1=D2),""да"")"
Selection.Copy
Range("F1:F100").Select
ActiveSheet.Paste
Решение задачи: «Поиск повторяющихся записей»
textual
Листинг программы
- Option Explicit
- Sub macro1()
- Dim i#, j#, List1RowsCount#, List2RowsCount#, asd1$, asd2$ 'объявляем переменные
- List1RowsCount = Sheets("Лист1").Cells(1, 1).End(xlDown).Row ' определяем последнюю строку на Лист1
- List2RowsCount = Sheets("Лист2").Cells(1, 1).End(xlDown).Row ' определяем последнюю строку на Лист2
- For i = 2 To List1RowsCount 'запускаем цикл по листу 1
- For j = 2 To List2RowsCount ' запускаем цикл по листу 2
- 'собираем "слово" из 4 ячеек листа1
- asd1 = Sheets("Лист1").Cells(i, 1) & Sheets("Лист1").Cells(i, 2) & Sheets("Лист1").Cells(i, 3) & Sheets("Лист1").Cells(i, 4)
- 'собираем "слово" из 4 ячеек листа1
- asd2 = Sheets("Лист2").Cells(j, 1) & Sheets("Лист2").Cells(j, 2) & Sheets("Лист2").Cells(j, 3) & Sheets("Лист2").Cells(j, 4)
- If asd1 = asd2 Then 'сравниваем полученные слова
- ' если условие истинное то проверяем ячейку на пустоту и если пустая ставим "да"
- ' на листе 1 и на листе 2
- If Sheets("Лист1").Cells(i, 5) = "" Then Sheets("Лист1").Cells(i, 5) = "Да"
- If Sheets("Лист2").Cells(j, 5) = "" Then Sheets("Лист2").Cells(j, 5) = "Да"
- Exit For ' выход из цикла j (строку надо удалить если на листе 2 предполагается дублирование информации)
- End If ' закрытие условия
- Next j ' закрытие цикла j
- Next i ' закрытие цикла i
- ' цикл простановки нет на листе 1
- For i = 2 To List1RowsCount
- If Sheets("Лист1").Cells(i, 5) = "" Then Sheets("Лист1").Cells(i, 5) = "Нет"
- Next i
- ' цикл простановки нет на листе 2
- For j = 2 To List2RowsCount
- If Sheets("Лист2").Cells(j, 5) = "" Then Sheets("Лист2").Cells(j, 5) = "Нет"
- Next j
- MsgBox "Готово" ' вывод сообщения о завершении работы макроса
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д