Noch ne Variante
11.04.2009 20:06:32
Ramses
Hallo
Damit wärest du nicht limitiert, für den Fall der Fälle, mit den Suchparametern
Option Explicit
Option Base 1
Sub Divide_String()
Dim strArr() As String, foundArr As Boolean
Dim chkStr As String, tmpPara As String
Dim i As Long, n As Long
Dim chkCol As Long
chkCol = 1 'Spalte A
ReDim Preserve strArr(1)
Do
For n = 1 To UBound(strArr)
tmpPara = tmpPara & strArr(n) & ";"
Next n
If tmpPara = ";" Then
tmpPara = ""
Else
tmpPara = Left(tmpPara, Len(tmpPara) - 1)
End If
chkStr = InputBox("Geben Sie einen Trennparameter an" & vbCrLf & _
"Wenn keine weitere Eingabe, dann drücken sie ""ABBRECHEN""" & vbCrLf & _
"Bisherige Suchparameter: " & vbCrLf & _
tmpPara, "Eingabe")
If StrPtr(chkStr) <> 0 Then
strArr(UBound(strArr)) = chkStr
ReDim Preserve strArr(UBound(strArr) + 1)
End If
tmpPara = ""
Loop Until StrPtr(chkStr) = 0
For i = 1 To Cells(Rows.Count, chkCol).End(xlUp).Row
With Cells(i, chkCol)
For n = 1 To UBound(strArr) - 1
If Left(.Value, Len(strArr(n))) = strArr(n) Then
.Offset(0, 1) = strArr(n)
.Offset(0, 2) = Right(.Value, Len(.Value) - Len(strArr(n)))
foundArr = True
Exit For
End If
Next n
If foundArr = False Then
For n = 1 To Len(.Value)
If IsNumeric(Mid(.Value, n, 1)) Then
.Offset(0, 1) = Left(.Value, n - 2)
.Offset(0, 2) = Right(.Value, Len(.Value) - n + 2)
End If
Next n
End If
foundArr = False
End With
Next i
End Sub
Gruss Rainer