Raccourcir les mots en fonction de la base de données dans Excel VBA

Question

J'essaie actuellement de remplacer des mots dans une cellule par des versions plus courtes en masse. J'ai un dictionnaire de mots pour faire plus court et aura une colonne de cellules qui ont besoin d'avoir un ou plusieurs des mots raccourcis. Je suis très nouveau à VBA et je ne suis pas sûr de la façon dont j'irais à ce sujet. J'ai essayé de chercher et trouvé quelques-uns qui changeraient le texte dans un doc de mot mais rien d'Excel pour exceler, au moins avec mes termes de recherche.

J'ai ajouté une image ici de l'idée, le texte à être raccourci est dans la colonne A, les mots qui peuvent être raccourcies sont dans la colonne C et les versions raccourcies sont dans la colonne D.

Sample

Answer 1

Voici une version complète sous si cela fonctionne mieux pour vous

Sub ReplaceViaList() 
Dim ws As Worksheet 
Dim repRng As Range 
Dim x As Long, lastRow As Long 
Dim repCol As Long, oldCol As Long, newCol As Long 
Dim oldStr As String, newStr As String 

'screenupdating/calc 
Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 

'define worksheet 
Set ws = ActiveSheet 

'define columns to work with 
repCol = 1 'col A 
oldCol = 3 'col C 
newCol = 4 'col D 

'find last row of replacement terms 
lastRow = ws.Cells(ws.Rows.Count, repCol).End(xlUp).Row 

'set range of items to be replaced 
Set repRng = ws.Range(_ 
    ws.Cells(2, repCol), _ 
    ws.Cells(lastRow, repCol) _ 
    ) 

'loop through cells in replacement terms 
For x = 2 To ws.Cells(ws.Rows.Count, oldCol).End(xlUp).Row 

    'define replacement terms 
    oldStr = ws.Cells(x, oldCol).Value 
    newStr = ws.Cells(x, newCol).Value 

    'replace 
    repRng.Replace What:=oldStr, Replacement:=newStr 

Next x 

'screenupdating/calc 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

End Sub 

Answer 2

Vous pouvez utiliser cette fonction UDF.

Function SubstituteMultiple(text As String, old_text As Range, new_text As Range) 
Dim i As Single 
For i = 1 To old_text.Cells.Count 
Result = Replace(LCase(text), LCase(old_text.Cells(i)), LCase(new_text.Cells(i))) 
text = Result 
Next i 
SubstituteMultiple = Result 
End Function 

Placez ce code dans votre module standard. puis écrivez cette formule =SubstituteMultiple(A2,$C$2:$C$11,$D$2:$D$11) dans la cellule B2 et faites-la glisser vers le bas.

Answer 3

Peut-être simple, remplacer en VBA serait le faire,

Sub test() 
    Dim searchval As Variant 
    Dim replaceval As Variant 

    searchval = Range("C1:C10") 
    replaceval = Range("D1:D10") 

    For i = 1 To 10 
     Columns("A:A").Replace What:=searchval(i, 1), Replacement:=replaceval(i, 1), LookAt:=xlPart 
    Next i 
End Sub