Hallo
Probier mal folgendes Makro.
Evtl den Bereich A1 bis H1000
entsprechend deiner Listen anpassen.
Sonst ändert er nur in diesem Bereich.
’ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub Ersetzen()
Dim Suchtext, Ersatztext
Dim Bereich As Range
Dim Suche As Range
Dim i As Long
Set Bereich = Range(„A1:H1000“) 'zu suchenden Bereich festlegen
’ ---------------------------
’ Hier auf ü richtigstellen
’ ---------------------------
Suchtext = ChrW(258) & ChrW(317)
Ersatztext = „ü“
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
MsgBox „Es wurden " & i & " Ersetzungen durchgeführt!“
End If
’ ----------------------------
’ Hier auf ö richtigstellen
’ ----------------------------
Suchtext = ChrW(258) & ChrW(182)
Ersatztext = „ö“
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
MsgBox „Es wurden " & i & " Ersetzungen durchgeführt!“
End If
’ ----------------------------
’ Hier auf ß richtigstellen
’ ----------------------------
Suchtext = ChrW(258) & ChrW(378)
Ersatztext = „ß“
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
MsgBox „Es wurden " & i & " Ersetzungen durchgeführt!“
End If
’ ----------------------------
’ Hier auf ä richtigstellen
’ ----------------------------
Suchtext = ChrW(258) & ChrW(164)
Ersatztext = „ä“
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
MsgBox „Es wurden " & i & " Ersetzungen durchgeführt!“
End If
’ ----------------------------
End Sub
’ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Gruß