Suchen und Ersetzen in Excel 2003

Option Explicit

Sub SuchenErsetzen_NurAlsGanzesWort()

Dim Zelle As Range
Dim s_Suchen As String, s_Ersetzen As String
Dim pos As Long, ret As Integer, l_len As Long
Dim s_Text As String, ersteAdresse As String


  Do
EingabeSuchen:
    s_Suchen = InputBox(Bitte geben sie das Suchwort ein !, _
              Eingabe Suchwort, s_Suchen)
  
    If 0 < InStr(1, s_Suchen,  ) Then
      MsgBox (keine Eingabe von Leerzeichen erlaubt.)
      GoTo EingabeSuchen
    End If
  
EingabeErsetzen:
    s_Ersetzen = InputBox(Bitte geben sie den Ersatz-String ein !, _
               Eingabe Ersetzen durch, s_Suchen)
  
    ret = MsgBox( _
            Suchen  : & vbTab & s_Suchen & vbLf & _
            Ersetzen: & vbTab & s_Ersetzen & vbLf & vbLf & _
            Soll dies durchgeführt werden ? , _
            vbYesNoCancel + vbQuestion + vbDefaultButton2)
    If ret = vbCancel Then Exit Sub
    If ret = vbYes Then Exit Do
  Loop

  With ActiveSheet.UsedRange
    Set Zelle = .Find( _
                  What:=s_Suchen, _
                  LookIn:=xlValues, _
                  Lookat:=xlPart, _
                  MatchCase:=True)
    If Not Zelle Is Nothing Then
      ersteAdresse = Zelle.Address
      Do
        s_Text = Zelle.Value
        pos = InStr(1, s_Text, s_Suchen)
        If Len(s_Suchen) = Len(s_Text) Then
          Zelle.Value = s_Ersetzen
        ElseIf pos = 1 Then
         ->Begriff steht am Anfang
         ->folgt ein Leerzeichen ?
          If Mid(s_Text, Len(s_Suchen) + 1, 1) =   Then
            s_Text = s_Ersetzen & Right(s_Text, Len(s_Text) - Len(s_Suchen))
            Zelle.Value = s_Text
          End If
        ElseIf Len(s_Text) = pos - 1 + Len(s_Suchen) Then
         ->Begriff steht am Ende
         ->davor ein Leerzeichen ?
          If Mid(s_Text, pos - 1, 1) =   Then
            s_Text = Left(s_Text, pos - 1) & s_Ersetzen
            Zelle.Value = s_Text
          End If
        Else
         ->Begriff steht in der Mitte
         ->Leerzeichen davor und dahinter ?
          If (Mid(s_Text, pos - 1, 1) =  ) And (Mid(s_Text, pos + Len(s_Suchen), 1) =  ) Then
            s_Text = Left(s_Text, pos - 1) & s_Ersetzen & Right(s_Text, Len(s_Text) - pos + 1 - Len(s_Suchen))
            Zelle.Value = s_Text
          End If
        End If
        
        Set Zelle = .FindNext(Zelle)
      Loop While Not Zelle Is Nothing And Zelle.Address <> ersteAdresse
    End If
End With

Aufraeumen:
  Set Zelle = Nothing
End Sub