'**********************************************************
Sub FORMEL_ErsetzenTextAlleInMappe()
->in alle Formeln jedes Blattes der Arbeitsmappe wird
->der Suchtext gesucht und in der jeweiligen Formel ersetzt
->
->Suchtext und Ersetzentext - werden abgefragt
->Option: Mehrfachersetzen in einer Formel - wird abgefragt
->in der jeweiligen Formel:
->- ja: werden alle Fundstellen ersetzt
->- nein: wird nur die erste Fundstelle ersetzt
->
->Option: Einzelabfrage vor dem Ersetzen - wird abgefragt
->- ja: vor jedem Ersetzen wird die Formel und die
->geänderte Formel angezeigt.
->Entspechend der Wahl ja/nein wird die Ersetzung
->durchgführt/übersprungen
->-nein: es wird ohne Nachfrage ersetzt
'**********************************************************
Dim ws As Worksheet, ws_akt As Worksheet
Dim s_Suchen As String, s_Ersetzen As String
Dim ret As Integer, ret2 As Integer
Dim b_mehrfachersetzen As Boolean, b_einzelNachfrage As Boolean
Dim s_Text_mehrfachersetzen As String
Dim s_Text_einzelNachfrage As String
Set ws_akt = ActiveSheet
ret = vbNo
Do While ret = vbNo
s_Suchen = InputBox( _
Bitte geben Sie den in Formeln zu ersetzenden Text ein. & _
vbLf & _
(Groß-/Kleinschreibung beahten!) & vbLf & _
Keine Eingabe -> Abbruch, _
Suchtext-Eingabe, s_Suchen)
If s_Suchen = Then Exit Sub
s_Ersetzen = InputBox( _
Bitte geben Sie den Ersatztext ein. & _
(Groß-/Kleinschreibung beahten!), _
Ersatztext-Eingabe, s_Ersetzen)
ret2 = MsgBox( _
Wenn der Suchbegriff mehrfach in einer Formel enthalten ist, & vbLf & _
sollen dann mehrfach ersetzt werden?, _
vbDefaultButton2 + vbYesNo + vbQuestion)
If ret2 = vbYes Then
b_mehrfachersetzen = True: s_Text_mehrfachersetzen = ja
Else
b_mehrfachersetzen = False: s_Text_mehrfachersetzen = nein
End If
ret2 = MsgBox( _
Soll jedes Ersetzen vorher bestätigt werden?, _
vbDefaultButton2 + vbYesNo + vbQuestion)
If ret2 = vbYes Then
b_einzelNachfrage = True: s_Text_einzelNachfrage = ja
Else
b_einzelNachfrage = False: s_Text_einzelNachfrage = nein
End If
ret = MsgBox( _
folgender Text: & vbLf & vbLf & s_Suchen & vbLf & vbLf & _
soll in allen Formeln der Arbeitsmappe durch: & vbLf & vbLf & _
s_Ersetzen & vbLf & vbLf & ersetzt werden ? & vbLf & vbLf & _
Mehrfachersetzung: & s_Text_mehrfachersetzen & vbLf & _
Einzelnachfrage: & s_Text_einzelNachfrage, _
vbDefaultButton2 + vbYesNo + vbQuestion)
Loop
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Call FORMEL_ErsetzenTextAlleEinerSeite( _
ws, s_Suchen, s_Ersetzen, b_mehrfachersetzen, b_einzelNachfrage)
Next
ws_akt.Activate
Set ws_akt = Nothing
End Sub
'**********************************************************
Function FORMEL_ErsetzenTextAlleEinerSeite(ws As Worksheet, _
s_Suchen As String, s_Ersetzen As String, _
b_mehrfachersetzen As Boolean, _
b_einzelNachfrage As Boolean)
'**********************************************************
Dim Zelle As Range, pos1 As Long, s_tmp As String, ret As Integer
->Formeln mit externen Verweisen suchen
If Len(s_Suchen) = 0 Then
MsgBox ( _
FORMEL_ErsetzenTextAlleEinerSeite: & vbLf & _
kein Suchtext angegeben :-()
Else
For Each Zelle In ws.UsedRange
If Left(Zelle.Formula, 1) = = Then
pos1 = 1
Do While pos1 > 0
pos1 = InStr(pos1 + 1, Zelle.Formula, s_Suchen)
If (pos1 > 0) Then
->suchtext gefunden
s_tmp = Left(Zelle.Formula, pos1 - 1) & s_Ersetzen & _
Right(Zelle.Formula, Len(Zelle.Formula) - pos1 + 1 - Len(s_Suchen))
If b_einzelNachfrage Then
ret = MsgBox( _
soll Formel & vbLf & vbLf & Zelle.Formula & vbLf & vbLf & _
durch Formel & vbLf & vbLf & _
s_tmp & vbLf & vbLf & ersetzt werden ?, _
vbDefaultButton2 + vbYesNo + vbQuestion)
If ret = vbYes Then
Application.DisplayAlerts = False
Zelle.Formula = s_tmp
Application.DisplayAlerts = True
->Suchanfangsposition auf den noch nicht behandlten
->Stringteil stellen, da sonst im ersetzen Text gesucht wird
pos1 = Len(Left(Zelle.Formula, pos1 - 1) & s_Ersetzen)
Else
->Suchanfangsposition auf den noch nicht behandlten
->Stringteil stellen, da sonst im ersetzen Text gesucht wird
pos1 = Len(Left(Zelle.Formula, pos1 - 1) & s_Suchen)
End If
Else
Application.DisplayAlerts = False
Zelle.Formula = s_tmp
Application.DisplayAlerts = True
->Suchanfangsposition auf den noch nicht behandlten
->Stringteil stellen, da sonst im ersetzen Text gesucht wird
pos1 = Len(Left(Zelle.Formula, pos1 - 1) & s_Ersetzen)
End If
If b_mehrfachersetzen = False Then Exit Do
End If
Loop
End If
Next
End If
End Function
