Ontdubbelen bij gelijke waarden van 3 kolommen

[Rhugien]

Hallo Vba-ers,

Na veel vragen te hebben bekeken en gelezen heb ik vooralsnog geen oplossing gevonden voor de volgende uitdaging...

Ik heb een lijst waarbij ik de gegevens wil ontdubbelen ALS van een regel 3 kolommen overeenkomen met een andere regel van diezelfde 3 kolommen.

In de bijlage vind je een voorbeeld;

de huidige code heb ik er in staan

Sub sorteertest()
Worksheets("media zoetermeer nff").Range("f1").Sort _
Key1:=Worksheets("media zoetermeer nff").Range("f1")
Set currentCell = Worksheets("media zoetermeer nff").Range("f1")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value = currentCell.Value Then
' currentCell.EntireRow.Delete
currentCell.EntireRow.Interior.ColorIndex = 3
End If
Set currentCell = nextCell
Loop
End Sub

De geeft enkel aan als er dubbele regels zijn op 1 kolom ( F ).
Wij hij dus moet doen is aangeven als er regels zijn die met zowel kolom E, F en G overeenkomen.. Als er 1 kolom niet overeenkomt hoeft deze ook niet te worden weergegeven.

Hoor graag jullie ideeen!

Gr. Rens

 

[Jack Nouws]

Hallo

Ik zou bijv gebruik maken van "duplicaten verwijderen". Hierin kun je aangeven op welke kolommen je wilt controleren op dubbele waarden. Je krijgt dan zoiets als dit.

Sub ontdubbelen()
    [Blad1!$A$1:$D$52].RemoveDuplicates Array(1, 2, 3), xlNo
End Sub

Veel succes

Met vr gr
Jack

 

[Rhugien]

Hallo Jack,

Bedankt voor je snelle reply, maar als ik deze code kopier ( ) dan doet hij het niet.
Moet ik er nog meer code aan toevoegen of zal die het zo al moeten doen?

Groeten,
Rens

 

[Wigi]

Jack Nouws had beter vermeld dat RemoveDuplicates enkel in Excel 2007 of hoger werkt. Wellicht heb jij die versie niet.

 

[snb]

Als het gaat om kolom C, D en E

Sub tst()
    For j = 1 To [A1].CurrentRegion.Rows.Count
        With [A1].CurrentRegion
            .AutoFilter 3, Cells(j, 3)
            .AutoFilter 4, Cells(j, 4)
            .AutoFilter 5, Cells(j, 5)
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .AutoFilter
        End With
        If j >= [A1].CurrentRegion.Rows.Count Then Exit For
    Next
End Sub