excel-vba
Поиск повторяющихся значений в диапазоне
Поиск…
Вступление
В определенные моменты вы будете оценивать диапазон данных, и вам нужно будет найти дубликаты в нем. Для больших наборов данных существует ряд подходов, которые вы можете использовать, используя код VBA или условные функции. В этом примере используется простое условие if-then в течение двух вложенных циклов for-next для проверки того, равна ли каждая ячейка в диапазоне для любой другой ячейки в диапазоне.
Найти дубликаты в диапазоне
Следующие тесты варьируются от 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 может быть отредактировано для извлечения дубликата ценность в другом месте. Однако механика рутины не изменилась.
Modified text is an extract of the original Stack Overflow Documentation
Лицензировано согласно CC BY-SA 3.0
Не связан с Stack Overflow