Hallo Community .-)
Folgende Lösung hab ich erstellt
Gruß Nighty
In eine Leere Mappe das Makro einfügen
Spalte A ab Zeile 2 die Sonderzeichen verschiedener Länder
Spalte B ab Zeile 2 die zu ersetzenden Zeichen
Makro starten
Datei mit doppelclick auswählen
Betreff alle Worksheets der Mappe!
Es werde alle Steuerzeichen gelöscht
Dann die Liste mit den Sonderzeichen abgearbeitet und die Zeichen ersetzt
Datei wird gespeichert
Fertig
Sub DeleteReplace()
Call EventsOff
Dim rngZelle As Range
Dim strZeichen As String
Dim WksIndex As Integer
Dim lngI As Long, ArrIndex As Long
Dim Sliste As Variant, GetMappe As Variant, a As Validation
Dim booZelleMitSteuerzeichen As Boolean
Sliste = Range("A2:B" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
GetMappe = Application.GetOpenFilename("Xls Files (*.xls), *.xls")
Workbooks.Open Filename:="" & GetMappe
For WksIndex = 1 To Worksheets.Count
Worksheets(WksIndex).Activate
For Each rngZelle In Worksheets(WksIndex).UsedRange.Cells
For lngI = 1 To Len(rngZelle.Value)
strZeichen = Mid(rngZelle.Value, lngI, 1)
Select Case Asc(strZeichen)
Case 1 To 31, 127, 129, 141, 143, 144, 157
If Not (rngZelle.HasFormula) Then
rngZelle.Value = Application.WorksheetFunction.Replace(rngZelle.Value, lngI, 1, Chr(9))
booZelleMitSteuerzeichen = True
End If
Case 160
If Not (rngZelle.HasFormula) Then
rngZelle.Value = Application.WorksheetFunction.Replace(rngZelle.Value, lngI, 1, Chr(32))
End If
End Select
Next lngI
If booZelleMitSteuerzeichen And Not (rngZelle.HasFormula) Then
rngZelle.Value = Application.WorksheetFunction.Clean(rngZelle.Value)
booZelleMitSteuerzeichen = False
End If
Next rngZelle
For ArrIndex = LBound(Sliste) To UBound(Sliste)
Cells.Replace What:=Sliste(ArrIndex, 1), Replacement:=Sliste(ArrIndex, 2), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Next ArrIndex
Next WksIndex
Workbooks(Mid(GetMappe, InStrRev(GetMappe, "\") + 1, Len(GetMappe))).Close SaveChanges:=True
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub