Dubbele rijen

[bs317]

Hallo,

Ik ben op zoek naar een macro om dubbele rijen op te zoeken.
Ik heb een bestand met honderden rijen en een tiental kolommen. Nu ben ik op zoek naar een macro om dubbele rijen te zoeken in dit bestand en dit op basis van twee criteria.
Vb. Ik zoek dubbele rijen die zowel in kolom B en kolom C over dezelfde gegevens bevatten(kolom B straatnamen en kolom C huisnummers). Deze rijen mogen niet verwijderd worden maar in een kleur aangeduid worden of iets anders zolang ze maar goed duidelijk zijn.
Alvast bedankt op voorhand.
Groetjes,
Bernard

 

[Wigi]

Bernard

is dit wat je wilt?

Sub Dubbelestraatenhuisnummer()
    Dim lngRow As Long, l As Long
    lngRow = Range("B1").End(xlDown).Row
    
    For l = 2 To lngRow
        If WorksheetFunction.CountIf(Range("B2:B" & lngRow), Range("B" & l)) > 1 And _
            WorksheetFunction.CountIf(Range("C2:C" & lngRow), Range("C" & l)) > 1 Then
                Range("B" & l).Resize(, 2).Interior.ColorIndex = 6
                Range("B" & l).Resize(, 2).Interior.Pattern = xlSolid
        End If
    Next
End Sub

Ik ga ervan uit dat je op rij 2 begint.

ColorIndex = 6 betekent een geel kleurtje.

Wigi

 

[bs317]

Hallo,

Alvast bedankt Wigi voor de snelle reactie.
Wat je me hebt opgestuurd werkt maar ik zit toch nog met een probleem. De lijst die ik heb moet ik eerst een filter opzetten op kolom A om die gegevens te filteren die ik wil hebben. Dus ik zou eigenlijk de dubbele rijen (niet kolom B en C maar G en H) eruit moeten halen in het actieve venster zonder eigenlijk rekening te houden met de rest van de rijen.
Dus volgende bewerking doe ik: Eerst de filter op, kolom G oplopens sorteren tot einde blad en dan de dubbele rijen laten zien(kolom G en H)
Bedankt alvast en hopelijk vraag ik niet teveel.

Groeten,
Bernard.

 

[Wigi]

Werkt dit, nadat de filter opstaat?

Sub Dubbelestraatenhuisnummer()
    Dim lngRow As Long, c As Range
    lngRow = Range("G1").End(xlDown).Row
    
    For Each c In Range("G2:G" & lngRow).SpecialCells(xlCellTypeVisible)
        If WorksheetFunction.CountIf(Range("G2:G" & lngRow).SpecialCells(xlCellTypeVisible), c) > 1 And _
            WorksheetFunction.CountIf(Range("H2:H" & lngRow).SpecialCells(xlCellTypeVisible), c.Offset(, 1)) > 1 Then
                Range("G" & l).Resize(, 2).Interior.ColorIndex = 6
                Range("G" & l).Resize(, 2).Interior.Pattern = xlSolid
        End If
    Next
End Sub

Wigi

 

[bs317]

Hallo Wig,

Nadat ik de filter op heb gezet en de macro wil laten lopen doet ie niks meer. In de vorige macro gaf ie de lijnen nog in kleur maar bij deze macro laat ie niets meer zien. Zelf weet ik er niks van maar daar zit ergens iets niet goed.
Bedankt alvast.
Bernard

 

[Wigi]

Hallo Wig,

Nadat ik de filter op heb gezet en de macro wil laten lopen doet ie niks meer. In de vorige macro gaf ie de lijnen nog in kleur maar bij deze macro laat ie niets meer zien. Zelf weet ik er niks van maar daar zit ergens iets niet goed.
Bedankt alvast.
Bernard

Ik denk dat het toch ongeveer goed zit. Maar een bestandje bijhangen kan daarover uitsluitsel geven.

Wigi

 

[bs317]

Hallo,

Hierbij stuur ik een deel van het bestand waaraan ik werk. De filter staat er nog niet op. In kolom A filter ik op "journaux" of iets anders en dan zou hij de dubbele lijnen in kolom G en H laten zien zodat ik deze nog verder kan bewerken.
Veel succes ermee.
Groeten
Bernard.

 

[Wigi]

Hallo

Zet de straat eens samen met het huisnummer en hang dan de file terug bij. Dat vereenvoudigt het zoeken van dubbele waarden zeer sterk. Bovendien heeft het absoluut geen nut om ze te splitsen. Je gaat toch nooit verder rekenen met de nummers alleen.

Wigi

 

[Wigi]

Hallo

Zet de straat eens samen met het huisnummer en hang dan de file terug bij. Dat vereenvoudigt het zoeken van dubbele waarden zeer sterk. Bovendien heeft het absoluut geen nut om ze te splitsen. Je gaat toch nooit verder rekenen met de nummers alleen.

Wigi

Als je het bovenstaande gedaan hebt, zal dit werken:

Sub Dubbelestraatenhuisnummer()
    Dim lngRow As Long, c As Range, d As Range, dup As Long
    lngRow = Range("G6").End(xlDown).Row
    
    For Each c In Range("G6:G" & lngRow).SpecialCells(xlCellTypeVisible)
        dup = 0
        For Each d In Range("G6", c).SpecialCells(xlCellTypeVisible)
            If c = d Then dup = dup + 1
        Next
        If dup > 1 Then
            c.Resize(, 2).Interior.ColorIndex = 6
            c.Resize(, 2).Interior.Pattern = xlSolid
        End If
    Next
    MsgBox "Klaar!"
End Sub

Wigi

 

[bs317]

Hallo,

Dit is eigenlijk hetgeen dat ik nodig had. Een klein min puntje is dat het wel zeer traag werkt, zeker als je ongeveer een 3000 rijen en meer hebt. Maar voor de rest werkt het prima. De macro haalt er al de dubbele rijen eruit.
Bedankt voor je goede hulp.
Groeten,

Bernard.

 

[Wigi]

Een klein min puntje is dat het wel zeer traag werkt, zeker als je ongeveer een 3000 rijen en meer hebt.

Ik weet dat het traag is voor veel rijen. Dat komt doordat heel veel lussen gebruikt worden. Ik zat met probleem dat de COUNTIF worksheet function niet werkt voor bereiken die niet aaneengesloten zijn. En dat is zo bij jou doordat er gefilterd is.

Als ik een oplossing vind laat ik het weten. Maar waarschijnlijk is dat niet.

Wigi