☰

Suchen und Ersetzen mehrerer Wörter in einer Spalte in Excel 2007

tag-icon • tag-icon microsoft-excel-2007 vba macros
Suchen und Ersetzen mehrerer Wörter in einer Spalte in Excel 2007 
Sub xLator2()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long
Dim from(), too()
Set s1 = Sheets("Sheet1") '   contains the data
Set s2 = Sheets("Sheet2") '   contains the translation table

s2.Activate

N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
    from(i) = Cells(i, 1).Value
    too(i) = Cells(i, 2).Value
Next i

s1.Activate

For i = LBound(from) To UBound(from)
    Cells.Replace What:=from(i), Replacement:=too(i)
Next i
End Sub

Ich verwende den obigen Code, um mehrere Wörter (in „Spalte A, Blatt 1“ durch Wörter in „Spalte B, Blatt 2“) im unten genannten Blatt zu suchen und zu ersetzen:

https://docs.google.com/spreadsheets/d/15TRLccDr_EAR8s78u-WGSkGpAecBf42_lhRkjCev_WE/edit?usp=sharing

Wenn ich dies jedoch (wie unten beschrieben) in einem anderen Blatt für andere Daten anwende, schlägt der Code fehl, d. h. ich erhalte verzerrte Wörter in Blatt1:

https://docs.google.com/spreadsheets/d/14ba9pQDjMPWJd4YFpGffhtVcHxml0LdUUVQ0prrOEUY/edit?usp=sharing

Bitte helfen Sie mir, damit ich Wörter in „Spalte A, Blatt1“ durch Wörter in „Spalte B, Blatt2“ ersetzen kann.

Hinweis: Oben wurden Links zu Google-Tabellen angegeben, ich habe jedoch Probleme mit der Excel 2007-Tabelle.

Ich bitte Sie, mir zu helfen, indem Sie mir den gesamten überarbeiteten Code zur Verfügung stellen, da ich nicht gut in VBA bin

Antwort1

Ich nehme an, Sie möchten die Ersetzung nur einmal vornehmen und weitere Regeln unterbinden, sobald eine Ersetzung erfolgt ist. Nehmen wir beispielsweise Ihr zweites Blatt: Zeile 12 „but“ sollte mit „howhower“ übersetzt werden, und weitere Regeln sollten unterbunden werden, damit „howhower“ nicht mit „hoyouever“ übersetzt wird (so wie Regel Nr. 17 „we“ mit „you“ übersetzt).

Eine Problemumgehung besteht darin, zunächst alles in ein Zwischensymbol zu übersetzen und dann in der zweiten Runde von den Zwischensymbolen in den gewünschten Ersatz zu übersetzen. Eine leichte Änderung Ihres Codes wie unten beschrieben funktioniert:

Sub xLator2()
Dim s1 As Worksheet, s2 As Worksheet
Dim N As Long, i As Long
Dim from(), too()
Set s1 = Sheets("Sheet1") '   contains the data
Set s2 = Sheets("Sheet2") '   contains the translation table

s2.Activate

N = Cells(Rows.Count, 1).End(xlUp).Row
ReDim from(1 To N)
ReDim too(1 To N)
For i = 1 To N
    from(i) = Cells(i, 1).Value
    too(i) = Cells(i, 2).Value
Next i

s1.Activate

' -------------- Modification starts here --------------------------
' Replace from from(i) to __MYREPLACEMENTi__  (where i is the counter)
For i = LBound(from) To UBound(from)
    Cells.Replace What:=from(i), Replacement:="__MYREPLACEMENT" + Str(i) + "__"
Next i
' Replace from __MYREPLACEMENTi__ to too(i)  (where i is the counter)
For i = LBound(from) To UBound(from)
    Cells.Replace What:="__MYREPLACEMENT" + Str(i) + "__", Replacement:=too(i)
Next i
' -------------- Modification ends here --------------------------
End Sub

verwandte Informationen