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