Waarde zoeken en verwijden uit kolom

[flipmoo]

Hallo,

Ik heb 2 kolommen met gegevens.
Kolom a & b
Nu wil ik dat de gegevens die in kolom a staan uit kolom b gehaald worden. En dat de waardes opschuiven zodat er geen lege cellen ontstaan.

Het resultaat is dus de waardes in kolom b op een rijd zonder de waardes die in kolom a staan.

Alvast bedankt.

Bekijk bijlage verwijderen.xlsx

 

[Timshel]

Macrootje:

Sub tsh()
    Dim Br, Bs
    Dim i As Long
    Dim Rng As Range
    
    Br = Sheets("Blad1").Columns(1).SpecialCells(2)
    Set Rng = Sheets("Blad1").Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
    Bs = Rng
    With CreateObject("System.Collections.Arraylist")
        For i = 1 To UBound(Bs)
            If IsError(Application.Match(Bs(i, 1), Br, 0)) Then .Add Bs(i, 1)
        Next
        Rng.ClearContents
        Rng.Resize(.Count) = Application.Transpose(.ToArray)
    End With
End Sub

 

[Cobbe]

Deze zou dat moeten aankunnen:

Sub cobbe()
For Each cl In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
 Set r = Range("B:B").Find(cl, LookAt:=xlWhole)
  If Not r Is Nothing Then
   Cells(r.Row, 2).Delete Shift:=xlUp
  End If
Next
End Sub

 

[flipmoo]

Geweldig!!

Duurde even aangezien er ruim 80.000 waardes in de lijst stonden.. maar het is gelukt!
Hartelijk dank!!

 

[MarcelBeug]

Duurde even aangezien er ruim 80.000 waardes in de lijst stonden

Dan zijn we wel benieuwd welke code je gebruikt hebt. Ik gok die van Cobbe?

 

[Cobbe]

In deze opgefokte tijden is het goed om soms wat te oefenen in geduld oefenen.

 

[Timshel]

Ik heb het toch even vergeleken. De code van Cobbe loopt een stuk sneller. Mijn code crasht bovendien bij 80.000 regels.

 

[Cobbe]

Nu hoort ge het ook eens van een ander.

 

[Timshel]

Dit zijn dan van die enigszins ongemakkelijke leermomentjes :shocked:

 

[MarcelBeug]

Verrassend en leerzaam.

Overigens: als er duplicaten voorkomen in kolom B dan worden die met de code van Cobbe net zo vaak verwijderd als dat ze voorkomen in kolom A, oftewel in die situatie kan er wat blijven hangen.

Een alternatief is nog om het handmatig te doen:
1. Voeg een kopregel toe
2. In C2 en gekopieerd naar beneden t/m de laatste rij met gegevens in kolom B: =VERGELIJKEN(B2;A:A;0)
3. Kopieer kolom C naar zichzelf met alleen waarden.
4. Zet autofilter aan.
5. Selecteer alle regels behalve die met #N/B in kolom C.
6. Maak de waarden in kolom B leeg.
7. Selecteer alles.
8. Blokkeer vensters zodat de bovenste rij niet meebladert.
9. Ga naar de laatste gevulde regel in kolom C en dan naar de cel ernaast in kolom B.
10. Met de Shift-toets ingedrukt: selecteer B1 zodat alle gegevens in kolom B zijn geselecteerd.
11. Selecteer alle lege cellen: Ctrl+G, speciaal, lege waarden.
12. Rechtsklik zo'n lege cel, kies verwijderen en cellen omhoog verplaatsen.
13. Verwijder kolom C (of maak deze leeg).

Ik heb een en ander getest met willekeurige getallen tussen 1 en 20000: kolom A gevuld t/m regel 10000 en kolom B t/m regel 20000, waarvan er ruim 12000 overbleven na verwijderen. Het leeg maken (stap 12) duurde het langst, zo'n 18 seconden.

 

[Warme bakkertje]

MarcelBeug's opmerking meegenomen.

In bijlage 3 macro's.
Cobbe's Find-methode
WB's Application.Match
WB2 die afrekent met eventuele dubbele waarden in kolom B (hiervoor moet je wel eerst enkele waarden aanpassen naar dubbele waarden in kolom B)

Resultaat
WB is een fractie sneller dan Cobbe, maar WB2 is even snel als Cobbe maar rekent wel af met eventuele dubbele waarden in kolom B.

 

[Cobbe]

En de winnaar is???? :d

 

[MarcelBeug]

En de winnaar is???? :d

Wat mij betreft: het collectief; wij met z'n allen.

 

[Warme bakkertje]

We zijn hier allemaal winnaars (het helpen van anderen is al een overwinning op zich). :thumb::thumb: Het is de zoektocht naar ... die het allemaal nog eens extra leuk maakt.:thumb::thumb:

 

[MagicPc1]

Helemaal gelijk Bakkertje:thumb::thumb::thumb::thumb::thumb::thumb: