Soms krijg je een data bestand waar veel fouten in zitten. Indien dat maar 20 rijen zijn kun je dat handmatig bijwerken. Maar als het tienduizend rijen zijn wordt dat een tijdrovend karwei. Vooral als er veel dubbele waarden in voorkomen.

Opzet van het blad is simpel. 

Kolom A: Originele tekst
Kolom B: De te zoeken tekst
Kolom C: De vervangende tekst
Kolom D: Nog niks, want hier komt de verbeterde tekst

Het enige waar je op moet letten is dat je de data in kolom B en C laat voorafgaan én eindigen met een spatie. Dat is niet zo moeilijk als je eerst even 2 hulpkolommen F en G maakt met de volgende formules die je doorvoert naar beneden.

In [F2] =" " & B2 & " "
In [G2] =" " & C2 & " "

Vervolgens die 2 kolommen kopiëren naar B en C en kiezen voor “Waarden Plakken” anders krijg je daar formules te staan en dat moet niet. Tenslotte onderstaande code in een module gooien en gaan met die banaan. Het enige tijdrovende is wellicht het opstellen van de 2 lijsten met de te zoeken en de te vervangen waarden. Dat weegt echter niet op tegen de tijdwinst die je behaalt als je alles handmatig zou moeten gaan corrigeren.

Sub Zoek_En_Vervang()
    Dim arrZoek As Variant
    Dim arrVervang As Variant
    Dim arrOrigineel As Variant
    Dim i, u As Long
    
    'Originele lijst met artikelen
    arrOrigineel = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
    
    'De te zoeken waarden
    arrZoek = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Value
    
    'De vervangende waarden
    arrVervang = Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).Value
    
    'De zoek en vervang actie
    For i = LBound(arrOrigineel, 1) To UBound(arrOrigineel, 1)
        For u = LBound(arrZoek, 1) To UBound(arrZoek, 1)
            arrOrigineel(i, 1) = Trim(Replace _
            (" " & arrOrigineel(i, 1) & " ", _
            arrZoek(u, 1), arrVervang(u, 1), , , vbTextCompare))
        Next
    Next
    
    'Resultaten in kolom D plaatsen
    Range("D2").Resize(UBound(arrOrigineel, 1)).Value = arrOrigineel
End Sub