Sorry: Waren noch zwei Zahlen falsch berechnet.
Sub Trennen()
Dim Zelle As Excel.Range
Dim strTAR_A As String
Dim strSRC As String
Dim strTAR_B As String
Dim LaufZahl As Long
With ActiveSheet
'Annahme: Strings in Spalte A, Ziel in Spalte A und B
For Each Zelle In .UsedRange.Columns(1)
strSRC = Zelle.Text
strTAR_A = ""
strTAR_B = ""
For LaufZahl = 1 To Len(strSRC)
Select Case Asc(Mid(strSRC, LaufZahl, 1))
Case 48 To 57, 65 To 90, 97 To 122, 246, 252, 223, 228, 220, 214, 196
strTAR_A = strTAR_A & Mid(strSRC, LaufZahl, 1)
Case Else
strTAR_B = strTAR_B & Mid(strSRC, LaufZahl, 1)
End Select
Next LaufZahl
Zelle = strTAR_A
Zelle.Offset(0, 1) = strTAR_B
Next
End With
End Sub
Falls Du die Werte bereinigt nur in B ausgeben willst
Sub Trennen()
Dim Zelle As Excel.Range
Dim strTAR_A As String
Dim strSRC As String
Dim strTAR_B As String
Dim LaufZahl As Long
With ActiveSheet
'Annahme: Strings in Spalte A, Ziel in Spalte A und B
For Each Zelle In .UsedRange.Columns(1)
strSRC = Zelle.Text
strTAR_B = ""
For LaufZahl = 1 To Len(strSRC)
Select Case Asc(Mid(strSRC, LaufZahl, 1))
Case 48 To 57, 65 To 90, 97 To 122, 246, 252, 223, 228, 220, 214, 196
strTAR_B = strTAR_B & Mid(strSRC, LaufZahl, 1)
End Select
Next LaufZahl
Zelle.Offset(0, 1) = strTAR_B
Next
End With
End Sub
|