AW: Teile ersetzen oder löschen
26.08.2017 14:22:03
Christian
... Fennek hat dir ja schon das "große Besteck" aufgezeigt, mit RegEx....
Hier eine Bastellösung, die dir noch .at, .AT, und AT weghaut, wenn denn am Ende stehend
Option Explicit
Private Sub machen()
Dim i As Variant
' Zu ersetzende Zeichen
Dim arrRepl1 As Variant
arrRepl1 = Array("!", "$", "?", " ")
Dim arrRepl2 As Variant
arrRepl2 = Array(".at", ".AT", "at", "AT")
With ThisWorkbook.Worksheets("Tabelle1")
Dim myRange As Range
Set myRange = .Range(.Cells(12, 2), .Cells(.Rows.Count, 2).End(xlUp))
' Zelle mit Austauschwert
Dim strNeuesZeichen
strNeuesZeichen = CStr(.Range("C1").Value)
Dim e As Variant
' Alle Zellen in der Suchspalte duchrgehen
For Each e In myRange
' Replacefunction mit allen zu ersetzenden Werten ausführen
For i = LBound(arrRepl1) To UBound(arrRepl1)
e.Value = Replace(e.Value, arrRepl1(i), strNeuesZeichen)
Next i
Next e
For Each e In myRange
' Replacefunction mit allen zu ersetzenden Werten ausführen (arrRepl2)
For i = LBound(arrRepl2) To UBound(arrRepl2)
If Right(e.Value, 2) = arrRepl2(i) Then
e.Value = Left(e.Value, Len(e.Value) - 2)
ElseIf Right(e.Value, 3) = arrRepl2(i) Then
e.Value = Left(e.Value, Len(e.Value) - 3)
End If
Next i
Next e
End With
End Sub
Gruß,CH.