Begriffe suchen und ersetzen mit Übersetzungsfile
11.02.2014 17:21:37
Stefan
in mehreren Excelfiles müssen bestimmte Begriffe ersetzt werden. Die zu ersetzenden Begriffe sind teilweise unterschiedlich, daher würde ich gerne kein starres Makro haben, sondern ein Tabellenblatt erstellen, in denen ich die zu suchenden und die ersetzten Begriffe gegnüberstellen würde und diese dann nach Bedarf immer weiter ergänzen könnte.
Beim Ersetzen von Begriffen in den Files würde ich gerne immer auf diese Liste (abgespeichert z.B. C:\Users\XYZ\Ersetzenliste.xls) zurückgreifen.
Ich stelle mir das also so vor:
Ich öffne ein File, und starte das Makro. Dann wird das ganze Blatt abgesucht nach zu ersetzenden Begriffen (die in der externen Liste stehen) und die Ersatzbegriffe eingefügt. Den untenstehenden Code habe ich im Internet gefunden, er funktioniert auch, allerdings muss ich an einer Stelle aufpassen.
In meiner Liste gibt es eine Suchen-Ersetzen Kombintation von:
absolviert -> 5-absolviert
und eine weitere
absolviert mit Fehler -> 6-absolviertFehler
Wenn jetzt in einer Zelle urpsprünglich "absolviert mit Fehler" stand und dann zunächst die erste Ersetzung passiert, wird daraus "5-absolviert mit Fehler", im nächsten Schritt dann "5-6-absolviert mit Fehler.
Wie kann ich einstellen, dass der Text nicht ersetzt wird, wenn in der Zelle nicht genau das richtige steht oder dass darauf geachtet wird, wenn etwas anderes besser passt. Ist wahrscheinlich nur ein kleiner Befehl, ich komm aber leider nicht drauf. Meine Notlösung wäre eine zusätzlich Zeile, die "5-6-absolviert mit Fehler" in "6-absolviert mit Fehler" umbenennt - das wäre allerdings recht umständlich und möglicherweise habe ich woanders das gleiche Problem.
Dankeschön!
Sub suchenersetzenausextfile()
Dim objExcel As New Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim i As Long
Set objExcel = New Excel.Application
Set objBook = objExcel.Workbooks.Open("C:\Users\XYZ\Ersetzenliste.xls")
Set objSheet = objBook.Worksheets("Ersetzenliste")
With objSheet
For i = 1 To .Cells(Cells.Rows.Count, 1).End(xlUp).Row
Cells.Replace What:=.Cells(i, 1), Replacement:=.Cells(i, 2), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next
End With
objBook.Close
Set objSheet = Nothing
Set objBook = Nothing
Set objExcel = Nothing
End Sub