Ga naar inhoud

VBA - cellen vergelijken en vervolgens cel aanpassen


Pas Cal
 Delen

Aanbevolen berichten

Goede dag,

Ik heb een bestand met +/- 70.000 regels. Ik wil een cellen vergelijken of deze voorkomt in een kolom. Dit kost met =vergelijken veel tijd. 

Bijgevoegd een voorbeeld. 

De bedoeling is wanneer in kolom A bij de betreffende regel 99999 staat, dat dan kolom C vergeleken wordt of de naam in kolom B (geheel) voorkomt. Wanneer dit zo is, moet in kolom F '1' gezet worden. In het voorbeeld zou alleen F2 naar '1' gezet moeten worden omdat Klaas (C2) voorkomt in kolom B.
Is dit mogelijk met een macro? Zo ja, heeft iemand een opzetje?

Testbestand.xlsx

Link naar reactie
Delen op andere sites


48 minuten geleden, dotchiejack zei:

Zo?


Sub Dotch()
    For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Cells(j, 4).Value = "=IF(RC[-3]=99999,ISERROR(MATCH(RC[-1], C[-2],0)),""Geen 99999"")"
        Cells(j, 5).Value = "=IF(RC[-1] = FALSE,1,0)"
Next
End Sub

Ctrl + q toetsen gebruiken in het voorbeeldje om het resultaat te zien.

pchelpforum.xlsb 13 kB · 2 downloads

Niet precies. Nu plaatst de macro alsnog een formule zodat de sheet langzaam wordt. Het is de bedoeling dat  binnen de macro gecheckt wordt of de betreffende cel in Kolom C voorkomt in kolom B. Zo ja, dan enkel een 1 zetten in kolom E.

Link naar reactie
Delen op andere sites


Hoe doet deze het ?

 

Sub tst()
    Set dic = CreateObject("scripting.dictionary")
    sn = Cells(1).CurrentRegion.Value
    For i = 2 To UBound(sn)
        x0 = dic.Item(sn(i, 2))
    Next
    For j = 2 To UBound(sn)
        If (sn(j, 1) = 99999) * (dic.exists(sn(j, 3))) Then sn(j, 5) = 1
    Next
    Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub

 

Link naar reactie
Delen op andere sites

Geplaatst: (aangepast)
15 uren geleden, bakerman zei:

Hoe doet deze het ?

 



Sub tst()
    Set dic = CreateObject("scripting.dictionary")
    sn = Cells(1).CurrentRegion.Value
    For i = 2 To UBound(sn)
        x0 = dic.Item(sn(i, 2))
    Next
    For j = 2 To UBound(sn)
        If (sn(j, 1) = 99999) * (dic.exists(sn(j, 3))) Then sn(j, 5) = 1
    Next
    Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub

 

 

edit: werkt perfect, dank u!

aangepast door Pas Cal
Link naar reactie
Delen op andere sites


Graag gedaan. Hoe valt de snelheid mee ?

 

Heb de code nog wat verder aangepast zodat nu eerst de oude resultaten in kolom E gewist worden.

 

Ook worden nu enkel de resultaten terug naar het werkblad geschreven zodat de rest van je data onaangeroerd blijft.

 

Sub tst()
    Dim b()
    Set dic = CreateObject("scripting.dictionary")
    sn = Cells(1).CurrentRegion.Value
    ReDim b(1 To UBound(sn) - 1, 1 To 1)
    For i = 2 To UBound(sn)
        x0 = dic.Item(sn(i, 2))
    Next
    For j = 2 To UBound(sn)
        If (sn(j, 1) = 99999) * (dic.exists(sn(j, 3))) Then b(j - 1, 1) = 1
    Next
    lRow = Range("E" & Rows.Count).End(xlUp).Row: If lRow = 1 Then lRow = 2
    Range("E2:E" & lRow).ClearContents
    Cells(2, 5).Resize(UBound(b), 1) = b
End Sub

 

Link naar reactie
Delen op andere sites

 Delen

×
×
  • Nieuwe aanmaken...