Verkürzen von Wörtern basierend auf der Datenbank in Excel VBA

Question

Ich versuche derzeit, Wörter in einer Zelle durch kürzere Versionen in der Masse zu ersetzen. Ich habe ein Wörterverzeichnis, um es kürzer zu machen, und ich habe eine Spalte mit Zellen, in denen eines oder mehrere Wörter gekürzt werden müssen.

Ich bin sehr neu in VBA und ich bin mir nicht sicher, wie ich das machen würde. Ich habe versucht zu suchen und fand einige, die Text in einem Word-Dokument ändern würde, aber nichts aus Excel zu übertreffen, zumindest mit meinen Suchbegriffen.

Ich habe hier ein Bild von der Idee hinzugefügt, der Text verkürzt in Spalte A werden soll, dass die Worte verkürzt werden können, sind in Spalte C und die verkürzten Versionen sind in Spalte D.

Sample

Answer 1

Hier ist eine vollständige Unter Version, wenn das besser für Sie arbeitet

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

Sie können diese UDF verwenden.

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 

Platzieren Sie diesen Code in Ihrem normalen Modul. Schreiben Sie dann diese Formel =SubstituteMultiple(A2,$C$2:$C$11,$D$2:$D$11) in die Zelle B2 und ziehen Sie sie nach unten.

Answer 3

Vielleicht einfach in VBA ersetzen würde es tun,

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