Duplicaten verwijderen

[Tweety1]

Ik ben opzoek naar een macro die het volgende doet.
Op blad1 wil ik de dubbele regels verwijderen waarvan de kolom A,B,C,D, en M overeenkomen met kolomen B,C,D,E en N op blad2.

In het voorbeeld bestand heb ik op blad1 in het rood aangeven welke verwijder dienen te worden

 

[snb]

Wat schuift deze opdracht (want van hulp om het zelf te leren lijkt hier geen sprake) ?

 

[Tweety1]

Ik zie dat verkeerde bestand is toegevoegd.

Ik heb wel wat zitten proberen alleen kom ik er niet uit
Hij verwijderd wel een regel maar loopt niet door en verwijderd ook niet de goede regels.

Option Explicit

Sub DuplicatenVerwijdern()
Application.ScreenUpdating = False

Dim startRegel As Integer
startRegel = 5

Dim Regel As Integer
Regel = startRegel

Dim bRegel As Integer

Do While (Blad1.Range("A" & Regel).Value <> "")

    Dim aVal As String
    Dim bVal As String
    Dim cVal As String
    Dim dVal As String
    Dim mVal As String

    aVal = Blad1.Range("A" & Regel).Value
    bVal = Blad1.Range("B" & Regel).Value
    cVal = Blad1.Range("C" & Regel).Value
    dVal = Blad1.Range("D" & Regel).Value
    mVal = Blad1.Range("M" & Regel).Value

    bRegel = startRegel

    Do While (Blad2.Range("B" & bRegel).Value <> "")

    Dim aVal2 As String
    Dim bVal2 As String
    Dim cVal2 As String
    Dim dVal2 As String
    Dim mVal2 As String


    aVal2 = Blad2.Range("B" & bRegel).Value
    bVal2 = Blad2.Range("C" & bRegel).Value
    cVal2 = Blad2.Range("D" & bRegel).Value
    dVal2 = Blad2.Range("E" & bRegel).Value
    mVal2 = Blad2.Range("N" & bRegel).Value
    
    If (aVal = aVal2 And bVal = bVal2 And cVal = cVal2 And dVal = dVal2 And mVal = mVal2) Then

        Blad1.Rows(Regel).Delete
        Regel = Regel - Regel
        Exit Do

    End If

    bRegel = bRegel + 1

    Loop

Regel = Regel + 1
Loop

End Sub

 

[HSV]

Dan merk ik op dat het verkeerde bestand er nog steeds staat.

 

[Tweety1]

In de bijlage een Excel bestand met daarin de macro.

 

[HSV]

Er is geen duplicaat bij in je bestand.

Sub DuplicatenVerwijdern()
Sheets("blad1").Cells(4, 1).CurrentRegion.RemoveDuplicates Array(1, 2, 3, 4, 13)
End Sub

 

[Tweety1]

Klopt. De bedoeling is dat de dubbele rijden die overeen komen met blad2 verwijderd.

 

[snb]

En nu in het Nederlands ?

 

[Tweety1]

Op blad1 zou ik graag de rijen willen verwijderen waarvan de cellen die in kolommen A,B,C,D, en M staan overeenkomen met kolommen B,C,D,E en N op blad2.

 

[VenA]

Waarom dan? En waarom gebruik je geen zinnige kolomkoppen? In Blad1 staat onder kop1 wat anders dan er in Blad2 onder kop1 staat.

 

[Tweety1]

Om te voorkomen dat er dubbele regels in het systeem worden ingelezen.
Op blad1 staan de gegevens die ik ga inlezen.
Op blad2 staat een export uit het het systeem. Eerste kolom bevat een unieke ID-code.

 

[VenA]

Dan kan je er beter voor zorgen dat het systeem geen dubbele waarden accepteert.

 

[HSV]

Maak er echte tabellen van, zit je ook niet met de variabele range in de functie Somproduct.

Sub hsv()
Application.DisplayAlerts = False
With Sheets("blad1")
 .Range("s2") = "=SUMPRODUCT((Blad1!A5=Blad2!B$2:B$8)*(Blad1!B5=Blad2!C2:C8)*(Blad1!C5=Blad2!D$2:D$8)*(Blad1!D5=Blad2!E$2:E$8)*(Blad1!M5=Blad2!N$2:N$8))>0"
    With .Cells(4, 1).CurrentRegion
     .AdvancedFilter 1, .Range("s1:s2")
     .Offset(1).Delete
     .Parent.ShowAllData
    End With
  .range("s2").clear
End With
End Sub

 

[Tweety1]

Thanks HSV, Ik ga er een echte tabel van maken.