nachfolgender Code.
Sub Trennzeichen_AT_weg()
Dim i As Variant
' Zu ersetzende Zeichen
Dim arrRepl1 As Variant
arrRepl1 = Array("-", "_", "/", " ", ";", ",")
Dim arrRepl2 As Variant
arrRepl2 = Array(Worksheets("Daten").Range("AE2") & "at", Worksheets("Daten").Range("AE2") & _
"aT", Worksheets("Daten").Range("AE2") & "At", Worksheets("Daten").Range("AE2") & "AT", "at", "aT", "At", "AT", Worksheets("Daten").Range("AE2") & "(at)", Worksheets("Daten").Range("AE2") & "(aT)", Worksheets("Daten").Range("AE2") & "(At)", Worksheets("Daten").Range("AE2") & "(AT)", "(at)", "(aT)", "(At)", "(AT)")
With ThisWorkbook.Worksheets("Aufstellung")
Dim myRange As Range
Set myRange = .Range(.Cells(13, 2), .Cells(.Rows.Count, 2).End(xlUp))
' Zelle mit Austauschwert
Dim strNeuesZeichen
strNeuesZeichen = CStr(Worksheets("Daten").Range("AE2").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)
ElseIf Right(e.Value, 4) = arrRepl2(i) Then
e.Value = Left(e.Value, Len(e.Value) - 4)
ElseIf Right(e.Value, 5) = arrRepl2(i) Then
e.Value = Left(e.Value, Len(e.Value) - 5)
End If
Next i
Next e
End With
End Sub
Der Code funktioniert sehr gut. Leider dauert er sehr lange bei großen Dateien.
Es würde reichen, wenn der Code zwischen i = bZ + 1 To bZ_nach ausgeführt werden würde.
Kann mir hier jemand weiterhelfen?