excel-vba
Lokaliseren van dubbele waarden in een bereik
Zoeken…
Invoering
Op bepaalde punten evalueert u een reeks gegevens en moet u de duplicaten erin vinden. Voor grotere gegevenssets zijn er een aantal benaderingen die u kunt gebruiken die ofwel VBA-code of voorwaardelijke functies gebruiken. In dit voorbeeld wordt een eenvoudige if-then-voorwaarde gebruikt binnen twee geneste for-next-lussen om te testen of elke cel in het bereik in waarde gelijk is aan een andere cel in het bereik.
Vind duplicaten in een bereik
De volgende tests variëren van A2 tot A7 voor dubbele waarden. Opmerking: dit voorbeeld illustreert een mogelijke oplossing als een eerste benadering van een oplossing. Het is sneller om een array te gebruiken dan een bereik en men zou collecties of woordenboeken of XML-methoden kunnen gebruiken om te controleren op duplicaten.
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
Afhankelijk van uw behoeften kan het voorbeeld worden gewijzigd - de bovengrens van n kan bijvoorbeeld de rijwaarde zijn van de laatste cel met gegevens in het bereik, of de actie in het geval van een True If-voorwaarde kan worden bewerkt om het duplicaat te extraheren waarde ergens anders. De mechanica van de routine zou echter niet veranderen.
Modified text is an extract of the original Stack Overflow Documentation
Licentie onder CC BY-SA 3.0
Niet aangesloten bij Stack Overflow