Поиск повторяющихся записей - 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
Листинг программы
  1. Option Explicit
  2. Sub macro1()
  3. Dim i#, j#, List1RowsCount#, List2RowsCount#, asd1$, asd2$ 'объявляем переменные
  4.  
  5. List1RowsCount = Sheets("Лист1").Cells(1, 1).End(xlDown).Row ' определяем последнюю строку на Лист1
  6. List2RowsCount = Sheets("Лист2").Cells(1, 1).End(xlDown).Row ' определяем последнюю строку на Лист2
  7.  
  8. For i = 2 To List1RowsCount 'запускаем цикл по листу 1
  9. For j = 2 To List2RowsCount ' запускаем цикл по листу 2
  10.  
  11.  
  12. 'собираем "слово" из 4 ячеек листа1
  13. asd1 = Sheets("Лист1").Cells(i, 1) & Sheets("Лист1").Cells(i, 2) & Sheets("Лист1").Cells(i, 3) & Sheets("Лист1").Cells(i, 4)
  14. 'собираем "слово" из 4 ячеек листа1
  15. asd2 = Sheets("Лист2").Cells(j, 1) & Sheets("Лист2").Cells(j, 2) & Sheets("Лист2").Cells(j, 3) & Sheets("Лист2").Cells(j, 4)
  16.  
  17.  
  18.  
  19. If asd1 = asd2 Then 'сравниваем полученные слова
  20.    ' если условие истинное то проверяем ячейку на пустоту и если пустая ставим "да"
  21.    ' на листе 1 и на листе 2
  22.    If Sheets("Лист1").Cells(i, 5) = "" Then Sheets("Лист1").Cells(i, 5) = "Да"
  23.     If Sheets("Лист2").Cells(j, 5) = "" Then Sheets("Лист2").Cells(j, 5) = "Да"
  24. Exit For ' выход из цикла j (строку надо удалить если на листе 2 предполагается дублирование информации)
  25. End If ' закрытие условия
  26.  
  27.  
  28. Next j ' закрытие цикла j
  29. Next i ' закрытие цикла i
  30.  
  31. ' цикл простановки нет на листе 1
  32. For i = 2 To List1RowsCount
  33.     If Sheets("Лист1").Cells(i, 5) = "" Then Sheets("Лист1").Cells(i, 5) = "Нет"
  34. Next i
  35.  
  36. ' цикл простановки нет на листе 2
  37. For j = 2 To List2RowsCount
  38.     If Sheets("Лист2").Cells(j, 5) = "" Then Sheets("Лист2").Cells(j, 5) = "Нет"
  39. Next j
  40.  
  41. MsgBox "Готово" ' вывод сообщения о завершении работы макроса
  42. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

8   голосов , оценка 3.625 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут