excel-vba
Поиск повторяющихся значений в диапазоне

Вступление

Найти дубликаты в диапазоне

Следующие тесты варьируются от A2 до A7 для повторяющихся значений. Примечание. Этот пример иллюстрирует возможное решение в качестве первого подхода к решению. Быстрее использовать массив, чем диапазон, и можно использовать коллекции или словари или методы xml для проверки дубликатов.

    Sub find_duplicates()
' Declare variables
  Dim ws     As Worksheet               ' worksheet
  Dim cell   As Range                   ' cell within worksheet range
  Dim n      As Integer                 ' highest row number
  Dim bFound As Boolean                 ' boolean flag, if duplicate is found
  Dim sFound As String: sFound = "|"    ' found duplicates
  Dim s      As String                  ' message string
  Dim s2     As String                  ' partial message string
' Set Sheet to memory
  Set ws = ThisWorkbook.Sheets("Duplicates")

' loop thru FULLY QUALIFIED REFERENCE
  For Each cell In ws.Range("A2:A7")
    bFound = False: s2 = ""             ' start each cell with empty values
 '  Check if first occurrence of this value as duplicate to avoid further searches
    If InStr(sFound, "|" & cell & "|") = 0 Then
    
      For n = cell.Row + 1 To 7           ' iterate starting point to avoid REDUNDANT SEARCH
        If cell = ws.Range("A" & n).Value Then
           If cell.Row <> n Then        ' only other cells, as same cell cannot be a duplicate
                 bFound = True             ' boolean flag
              '  found duplicates in cell A{n}
                 s2 = s2 & vbNewLine & " -> duplicate in A" & n
           End If
        End If
       Next
     End If
   ' notice all found duplicates
     If bFound Then
         ' add value to list of all found duplicate values
         ' (could be easily split to an array for further analyze)
           sFound = sFound & cell & "|"
           s = s & cell.Address & " (value=" & cell & ")" & s2 & vbNewLine & vbNewLine
     End If
   Next
' Messagebox with final result
  MsgBox "Duplicate values are " & sFound & vbNewLine & vbNewLine & s, vbInformation, "Found duplicates"
End Sub

В зависимости от ваших потребностей пример может быть изменен - ​​например, верхний предел n может быть значением строки последней ячейки с данными в диапазоне, или действие в случае условия Истина If может быть отредактировано для извлечения дубликата ценность в другом месте. Однако механика рутины не изменилась.