Поиск повторяющихся записей - 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