hab's eben selber gelöst:
Sub abmaße()
Dim y As Double
y = 2
Dim x As Integer
Dim Text As String
Dim TextEinzel() As String
Dim N As Long
Do While Tabelle1.Cells(y, 1) <> ""
Text = Tabelle1.Cells(y, 2)
TextEinzel = Split(Text, "x")
If UBound(TextEinzel) = 0 Then
Tabelle1.Cells(y, 3) = TextEinzel(0)
Tabelle1.Cells(y, 5) = "3000"
End If
If UBound(TextEinzel) = 1 Then
Tabelle1.Cells(y, 4) = TextEinzel(0)
Tabelle1.Cells(y, 3) = TextEinzel(1)
Tabelle1.Cells(y, 5) = "3000"
End If
If UBound(TextEinzel) = 2 Then
Tabelle1.Cells(y, 5) = TextEinzel(0)
Tabelle1.Cells(y, 4) = TextEinzel(1)
Tabelle1.Cells(y, 3) = TextEinzel(2)
End If
y = y + 1
Loop
End Sub
gruß Seba |