Excel: automatisierte Suchen-Ersetzen-Funktion/VBA

Computer: Software & Programmierung Office Software
#1

hallo erstmal,

ich steh vor einem Problem in Excel eine automatisierte suchen-und-ersetzen-Funktion zu erstellen (bzw. ein passendes Makro) und hoffe ihr könnt mir dabei etwas helfen? Die Vorgaben gestalten sich wie folgt … sollte noch etwas unklar sein, gebe ich gerne weitere Auskunft :smile:danke jedenfalls schon mal für die Mühe

lg,
mjolle

Vorgabe:
Spalte A: Fließtext, variable Länge, Zahlen, Sonderzeichen …
Spalte B: Liste zu suchender Begriffe/Zeichen
Spalte C: in Zusammenhang mit Spalte B - Liste mit Begriffen/Zeichen, durch die Werte in Spalte A ersetzt werden sollen

Ziel:

Begriffe/Zeichen aus Spalte B sollen im Fließtext von Spalte A gesucht werden und dort (oder in Spalte D) durch die passenden Begriffe/Zeichen aus Spalte C ersetzt werden (ist Spalte C leer/hat keinen Ersatzwert für Spalte B, soll der Suchbegriff durch „“ ersetzt/gelöscht werden)

Beispiel:

             A              B          C           D
1    ich gehe          ä         ae          gehe
2    erste Länge    ich                     erste Laenge
3    du ich                                       du
4    Regen                                      Regen
5    Kälte                                        Kaelte
6    Löwe                                        Löwe

#2

Hallo

An deinem Beispiel angelehnt empfehl ich mal folgendes Makro.

'- - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub Ersetzen()

Dim Suchtext, Ersatztext
Dim Bereich As Range
Dim Suche As Range
Dim i As Long

’ ----------------------------------------------------
’ Hier wird der Bereich festgelegt in dem geändert wird
’ ----------------------------------------------------

Set Bereich = Range(„A1:A20“) 'zu suchenden Bereich festlegen

’ ---------------------------
’ Hier wird von B1 auf C1 ersetzt
’ ---------------------------

Suchtext = Cells (1, 2)
Ersatztext = Cells (1, 3)

Set Suche = Bereich.Find(what:=Suchtext, LookIn:=xlFormulas, LookAt:=xlPart)

If Suche Is Nothing Then
MsgBox „Keine übereinstimmende Daten gefunden!“
Else
Application.ScreenUpdating = False

Do
i = i + 1
Suche.Value = Replace(Suche.Value, Suchtext, Ersatztext)
Set Suche = Bereich.FindNext(Suche)
Loop Until Suche Is Nothing

End If

’ --------------------------------
’ Hier wird von B2 auf C2 ersetzt
’ --------------------------------

Suchtext = Cells (2, 2)
Ersatztext = Cells (2, 3)

Set Suche = Bereich.Find(what:=Suchtext, LookIn:=xlFormulas, LookAt:=xlPart)

If Suche Is Nothing Then
MsgBox „Keine übereinstimmende Daten gefunden!“
Else
Application.ScreenUpdating = False

Do
k = k + 1
Suche.Value = Replace(Suche.Value, Suchtext, Ersatztext)
Set Suche = Bereich.FindNext(Suche)
Loop Until Suche Is Nothing

End If

’ ----------------------------

End Sub

'- - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Gruß

#3

hey, danke für die antwort.
die lösung gefällt mir recht gut, allerdings ist sie - für meinen bedarf - noch zu statisch (ich weiß nicht, wieviele einträge die änderungsliste haben wird bzw. soll es möglich sein diese im lauf zu erweitern). ohne einen tau von vba zu haben, hab ich drum mal versucht die einzelnen input-teile zu nehmen, mit dem hammer fest draufzuhaun und ja … vielleicht nicht die schönste lösung, aber es scheint irgendwie doch zu funktionieren. danke jedenfalls nochmal für die grundstruktur.

änderungen waren: erste zeile bleibt unberührt, variable listeneinträge im eingabe und änderungsbereich, eingabeliste und änderungsliste auf zwei verschiedenen tabellenblättern, berücksichtigung der groß-/kleinschreibung

Sub SuchenErsetzen()

Dim Suchtext, Ersatztext
Dim Bereich As Range
Dim Suche As Range
Dim anz As Long
Dim i As Long

’ -------------------------------------------------
’ Suchbereich - Anzahl der Listeneinträge festlegen
’ -------------------------------------------------

i = Worksheets(„Tabelle1“).Cells(Rows.Count, „A“).End(xlUp).Row 'letzte befüllte Zelle der Suchliste

Sheets(„Tabelle2“).Activate
anz = ActiveSheet.Cells(Rows.Count, „A“).End(xlUp).Row 'letzte befüllte Zelle im Suchbereich
Set Bereich = ActiveSheet.Range(Cells(2, 1), Cells(anz, 1)) 'Suchbereich: Tabelle2 - Spalte A - Zeile 2 bis letzter Eintrag

’ ---------------------------------------------------------
’ Werte im Suchbereich mit Suchen-Ersetzen-Liste abgleichen
’ ---------------------------------------------------------

Do
Suchtext = Worksheets(„Tabelle1“).Cells(i, 1)
Ersatztext = Worksheets(„Tabelle1“).Cells(i, 2)
Bereich.Select
Selection.Replace What:=Suchtext, Replacement:=Ersatztext, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
i = i - 1
Loop Until i = 1

End Sub