Dubbels

[jpvs]

Krijg het niet voor elkaar.
Ben een macro aan het zoeken die werkelijk alle dubbels eruit gooit.

A
A
C
D
D

zodat er C alleen te zien is.

Pierre

 

[richard1970]

Zomaar een ideetje.
Voeg een hulpkolom toe waarin je de formule =AANTAL.ALS(A:A;A1) zet. Kopieer de kolom en plak de waarden. Laat de macro alle rijen verwijderen waar het getal groter dan 1 is.
Verwijder dan weer de hulpkolom.

Richard

 

[jpvs]

Richard,

Dit is natuurlijk ook een oplossing maar was wel aan het zoeken of er een macro van bestond?

Dit heb ik al gevonden als macro:

Sub ShowDuplicateRows()
Dim i As Integer, j As Integer
Dim AantalRijen
Dim EersteInhoud As Variant, VolgendeInhoud As Variant

AantalRijen = Worksheets(1).UsedRange.Rows.Count
For i = 1 To AantalRijen - 1
EersteInhoud = Worksheets(1).Cells(i, 1)
If EersteInhoud <> "" Then
For j = i + 1 To AantalRijen
VolgendeInhoud = Worksheets(1).Cells(j, 1)
If VolgendeInhoud = EersteInhoud Then
Worksheets(1).Cells(j, 1).Interior.ColorIndex = 4
Worksheets(1).Cells(i, 1).Interior.ColorIndex = 4
End If
Next
End If
Next
End Sub

Maar slaag er niet in om het selecteerde te deleten?

Pierre

 

[Wigi]

Zoiets Pierre?

Sub doedubbelsweg()
Dim rngEvaluate As Range, d As Range, rngtoDelete As Range
Set rngEvaluate = Range("A1", Range("A1").End(xlDown))
Set rngtoDelete = Cells(1, Columns.Count)
For Each d In rngEvaluate
    If WorksheetFunction.CountIf(rngEvaluate, d) > 1 Then
        Set rngtoDelete = Union(rngtoDelete, d)
    End If
Next
rngtoDelete.ClearContents
End Sub

Wigi

 

[jpvs]

Wigi,

Bedankt voor de macro en met zo weinig regels.

Pierre

 

[Wigi]

Ook, de IF kan op 1 regel staan:

Sub doedubbelsweg()
Dim rngEvaluate As Range, d As Range, rngtoDelete As Range
Set rngEvaluate = Range("A1", Range("A1").End(xlDown))
Set rngtoDelete = Cells(1, Columns.Count)
For Each d In rngEvaluate
    If WorksheetFunction.CountIf(rngEvaluate, d) > 1 Then Set rngtoDelete = Union(rngtoDelete, d)
Next
rngtoDelete.ClearContents
End Sub

Graag gedaan Pierre.

Zet de vraag op opgelost aub.

Wigi