AW: Zeichen löschen udn ersetzen
Ramses
Hallo
das solle tun
Option Explicit
Sub ex_Char()
Dim tarRng As Range, tarC As Range
Dim tmpCtr As Long
Dim repChr As String, newChr As String
On Error Resume Next
Set tarRng = Application.InputBox("Zellbereich zum ersetzen auswählen", "Auswahl", Type:=8)
If tarRng Is Nothing Then
MsgBox "Abbruch", vbCritical + vbOKOnly, "Fehler"
Exit Sub
End If
repChr = InputBox("Welche Zeichenfolge soll ersetzt werden", "Suchen")
If StrPtr(repChr) = 0 Then
MsgBox "Abbruch", vbCritical + vbOKOnly, "Fehler"
Exit Sub
End If
newChr = InputBox("Welche Zeichenfolge soll für:""" & repChr & """ gesetzt werden", "Ersetzen")
If StrPtr(newChr) = 0 Then
MsgBox "Abbruch", vbCritical + vbOKOnly, "Fehler"
Exit Sub
End If
tmpCtr = 0
For Each tarC In tarRng
If Left(tarC, 2) = repChr Then
tarC = newChr & Right(tarC, Len(tarC) - 2)
tmpCtr = tmpCtr + 1
End If
Next
MsgBox tmpCtr & " Ersetzungen vorgenommen", vbOKOnly + vbInformation, "Abschluss"
End Sub
Gruss Rainer