VBA: wis dubbele rij per blok

Status
Niet open voor verdere reacties.

Killerclown

Gebruiker
Lid geworden
30 dec 2007
Berichten
181
Goeiemiddag,

Wie kan mij snel uit de nood helpen?

Ik zoek een VBA-manier om in mijn excel snel een dubbele waarde uit te halen.
(voorbeeld in bijlage)

Per blok met zelfde nummer in kolom A moet er gekeken worden of er in kolom B de waarde 634-6 voorkomt en deze rij dubbel is in dat blok en dan deze rij wissen.
Ik moet 1 rij met nummer 634-6 per blok overhouden.

Aangezien ik een leek ben en er veel te lang op moet zoeken, hoop ik dat iemand hier snel een idee heeft en iets uit zijn/haar mouw kan schudden.

Alvast heel veel dank
 

Bijlagen

Ik snap het niet helemaal; wil je uit je blok van 25o rijen één rij overhouden? Excel heeft een prima functie ontdubbelen; die haalt uit jouw gegevensblok gelijk 11 rijen weg. Hou je er nog 238 over. Daar zit uiteraard ook jouw waarde 634-6 bij. 9 stuks namelijk. Geen VBA voor nodig.
 
Nee, dat zou ik ook kunnen :-)

In kolom A staan verschillende nummers. Dezelfde nummers in kolom A vormen 1 blok.
Binnen dat ene blok van dezelfde nummers in kolom A wil ik checken of er in kolom B een of meerdere waardes 634-6 tussen zit. Als er meerdere lijnen zijn, dan moet in dat ene blok de dubbele lijn gewist worden.
En zo voor alle blokken van dezelfde nummers in kolom A.

Hopelijk verduidelijkt dit al iets meer.
 
Als je deze runt wordt de huidige data omgezet naar hetgeen dat je wenst, gebaseerd op je voorbeeldbestand

Code:
Sub jec()
 ar = Cells(1, 1).CurrentRegion
 Dim jv()
 
 With CreateObject("scripting.dictionary")
    For i = 2 To UBound(ar)
      If InStr("|" & Join(jv, "|") & "|", "|" & ar(i, 1) & "|634-6|") = 0 Or ar(i, 2) <> "634-6" Then
         .Item(.Count) = Array(ar(i, 1), ar(i, 2))
          ReDim Preserve jv(x)
          jv(x) = Join(.Item(.Count - 1), "|"): x = x + 1
      End If
    Next
   Cells(1, 1).CurrentRegion.Offset(1).ClearContents
   Cells(2, 1).Resize(.Count, 2) = Application.Index(.items, 0, 0)
 End With
End Sub
 
Laatst bewerkt:
Thanks. Dat was het wat ik zocht voor mijn excels met 30000 lijnen.
Mijn excuses voor de late reactie maar ik was er onmiddellijk ingevlogen :-)
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan