Zoeken op woorden binnen en cel en vervangen mbv VBA

[Ivanhoes]

Hoi mensen,

Ik ben op zoek naar een VBA-code, waarbij de code in een kolom (bv. A3:A50) binnen
alle cellen op zoek moet naar een bepaalde waarde (bv een woord), dat in een ander tabblad
in een lijst opgegeven wordt.

De waarde (dus bv een hele zin) in de betreffende cellen moet vervolgens vervangen worden
een nieuw woord/zin. Dit woord/deze zin staat óók vermeld in een ander tabblad.

Zie vooral het bijgevoegde bestand, want dat zegt vermoedelijk meer dan al mijn opmerkingen.


Een klein voorbeeldje dan in woorden:

In A5 staat de zin: Ik hou van topsport.
Ik zoek het woord sport en als dat gevonden wordt,
moet de waarde in de cel "groen" worden.
In A5 wordt de nieuwe waarde nu dus "groen".

De woorden die ik zoek betreffen dus niet alleen zelfstandige woorden, maar ook gedeeltes van woorden.

Ik hoop dat iemand mij hieraan kan helpen.

Alvast bedankt en groetjes,

Ivanhoes

 

[MarcelBeug]

Als het ook een formule mag zijn, kijk dan eens naar deze bijlage, met de mooie formule in D4 en gekopieerd naar beneden:

=ALS($A4="";"";ZOEKEN(1;-VIND.SPEC(Lijst!$A$4:$A$8;$A4);Lijst!$B$4:$B$8)&"")

Ik heb van de lijst een tabel gemaakt, zodat het bereik in de formule automatisch aangepast wordt als de omvang van de lijst wijzigt.

 

[Ivanhoes]

Hoi MarcelBeug,

Bedankt voor je, zeer snelle, antwoord!

Ik vroeg eigenlijk VBA, omdat ik er vanuit ging dat het niet in een formule kon
Dat ik nu deze formule heb is mooi, want ik zou hiermee in het oorspronkelijke
bestand meekunnen werken.

Toch wil ik ook graag de VBA-code willen hebben, want dan zou ik het zoeken en vervangen
ook kunnen uitvoeren dmv een knop.

Mocht niemand dat antwoord weten, weet dan dat ik je formule in ieder geval dus gebruiken! Bedankt nogmaals.

Groetjes,

Ivanhoes.

Ps: Ik laat dit topic nog 1 dag open staan. Als er dan geen andere reacties mbt tot VBA zijn gekomen, zal ik het topic op opgelost zetten!

 

[snb]

Neem eens een macro op en fatsoeneer het resultaat.

 

[MarcelBeug]

Of probeer deze eens.

Sub ZoekVervang()

    Dim bronTekst() As Variant
    Dim doelTekst() As Variant
    Dim zoekVervangLijst() As Variant
    Dim i As Integer, j As Integer
   
    Sheets("Lijst").Activate
    zoekVervangLijst = Range("A4", Cells(Rows.Count, 1).End(xlUp).Offset(0, 1))
    Sheets("Gegevens").Activate
    bronTekst = Range("A4", Cells(Rows.Count, 1).End(xlUp))
    ReDim doelTekst(1 To UBound(bronTekst), 1 To 1)
    
    For i = 1 To UBound(bronTekst)
        For j = 1 To UBound(zoekVervangLijst, 1)
            If InStr(1, bronTekst(i, 1), zoekVervangLijst(j, 1), vbTextCompare) Then
                doelTekst(i, 1) = zoekVervangLijst(j, 2)
                Exit For
            End If
        Next j
    Next i
    Range("D4").Resize(UBound(doelTekst), 1) = doelTekst
    
End Sub

 

[snb]

@MB

Vermijd 'Select' en 'Activate' in VBA.
Neem eens een macro op terwijl je de ingebouwsde zoek/vervangen funktie in Excel gebruikt.

 

[MarcelBeug]

Vermijd 'Select' en 'Activate' in VBA.

Ja, dat probeer ik ook, maar ik kreeg zoekVervangLijst niet gevuld zonder eerst sheets("Lijst") te activeren.

Met de volgende code krijg ik de melding dat typen niet overeen komen

With Sheets("Lijst")
        zoekVervangLijst = .Range(.Cells(4, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1))
End With

 

[HSV]

Dim zoekVervangLijst

 

[snb]

Gebruik altijd cel A1 in ieder werkblad, zodat usedrange en cells(1).currentregion een voorspelbaar resultaat opleveren.

Sub M_snb()
    sn = Sheets("lijst").Cells(1).CurrentRegion
    
    With Sheets("gegevens").Columns(1)
       For j = 2 To UBound(sn)
          .Replace sn(j, 1), sn(j, 2)
       Next
    End With
End Sub

 

[Ivanhoes]

Hoi mensen,

Bedankt allen voor de reacties!
De formule werkt zoals het moet en....de vba-code werkt óók zoals het moet!
Kortom, de vraag is bij deze opgelost.

Toch nog even een kennisvraagje: Ik zag dat snb antwoordde:

Vermijd 'Select' en 'Activate' in VBA.

Welke reden is er om dit te vermijden?


Groetjes,

Ivanhoes.

 

[snb]

overbodig, onnodig veel VBAcode, sterk vertragend, beeldschermflikkeringen, .....

 

[Ivanhoes]

Meer hoef ik niet te weten...Bedankt snb!

 

[MarcelBeug]

HSV en snb bedankt.
Het ging hier overigens niet om gewoon zoeken en vervangen van een string, maar om zoeken naar een string en vervangen van de gehele celinhoud.

 

[snb]

Dan kan het zo:

Sub M_snb()
    sn = Sheets("lijst").Cells(1).CurrentRegion
    
    With Sheets("gegevens").Columns(1)
       For j = 2 To UBound(sn)
          .Replace "*" & sn(j, 1) & "*", sn(j, 2)
       Next
    End With
End Sub