Поиск дублей в колонке

1 Звезда2 Звезды3 Звезды4 Звезды5 Звезд (Пока оценок нет)
Загрузка...

Задача:

В екселе есть колонка с текстами, нужно найти дублирующие текста

Решение:

Создадим макрос, который будет сравнивать содержимое двух колонок, в первой колонке будут ячейки с исходным текстом, во второй колонке будут формироваться ячейки с текстом который уникальный.

То есть, проходя каждую ячейку первой колонки, делаем сравнение со всеми ячейками второй колонки, и если совпадений не найдено, добавляем во вторую колонку уникальный текст из первой колонки, и в третей колонке маркируем для наглядности, 0 — нет дубля, 1 — дубль.

Теперь сам код


Sub Макрос1()

  Application.DisplayAlerts = False
  Row = 1 ' начальная строка
  col1 = 1 ' колонка с исходным текстом
  col2 = 2 ' колонка с уникальным текстом, формируется
  col3 = 3 ' маркер, 0 - уникальный, 1 - дубль
  max_rows = 500 'максимальный диапазон строк
  x1 = 1
  x2 = 1

  For Each cel In Range(Cells(Row, col1), Cells(max_rows, col1))

    Field1 = Trim(cel.Text)
    If Len(Field1) > 0 Then
      flg = False

      For Each cel2 In Range(Cells(Row, col2), Cells(max_rows, col2))
        Field2 = Trim(cel2.Text)
        If Field1 = Field2 Then
          flg = True
        End If
      Next cel2

      If flg = True Then
        Cells(x1, col3) = 1
      Else
        Cells(x1, col3) = 0
        Cells(x2, col2) = Field1
        x2 = x2 + 1
      End If

      x1 = x1 + 1
    Else
      Exit For
    End If

  Next cel

  Application.DisplayAlerts = True
End Sub

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *