|
Hallo Björn,
da hast du echt ein cooles Makro gefunden. Leier hat mein altes Excel nur 65536 Zeilen, sodass ich den Fehler leider nicht nachvollziehen kann. Daher hier mal eine alternative Lösung von mir ohne Zuhilfenahme der Problemfunktionen. Ist zwar nicht ganz so elegant aber sollte funktionieren:
Sub NurDaten()
Dim z As Long, i As Long, found As Boolean
calc = Application.Calculation
Application.Calculation = xlCalculationManual
Range("A:A").Copy
With Range("B:B")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
For z = 32 To 255
If Chr(z) Like "[!0-9?*.~-]" Then
.Replace Chr(z), "", xlPart
ElseIf Chr(z) Like "[*?~]" Then
.Replace "~" & Chr(z), "", xlPart
End If
Next z
For z = ActiveSheet.UsedRange.Row To ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Row - 1
found = False
If .Cells(z) Like "*##.##.##-##.##.##*" Or .Cells(z) Like "*##.##.##*" Then
For i = 1 To Len(.Cells(z)) - 7
If Mid(.Cells(z), i, 17) Like "##.##.##-##.##.##" Then
.Cells(z) = Mid(.Cells(z), i, 17)
found = True
Exit For
ElseIf Mid(.Cells(z), i, 8) Like "##.##.##" Then
.Cells(z) = Mid(.Cells(z), i, 8)
found = True
Exit For
End If
Next i
End If
If found = False Then .Cells(z) = ""
If (z - ActiveSheet.UsedRange.Row + 1) Mod 100 = 0 Then
Application.StatusBar = z - ActiveSheet.UsedRange.Row + 1 & " von " & ActiveSheet.UsedRange.Rows.Count & " aktualisiert"
End If
Next z
End With
Application.StatusBar = False
Application.Calculation = calc
End Sub
Gruß Mr. K.
|