chronologisch sortieren II
07.03.2021 14:59:45
Sid
prinzipiell funktioniert es soweit, nur wird jede Zeile doppelt ausgegeben.
Wie läßt sich das abstellen ohne das man das Ganze crasht (so wie ich).
Option Explicit
Dim Stufen As Long
Sub Start()
Dim strEingabe As String
Dim arr
strEingabe = InputBox("Bitte geben sie semikolon getrennt ein: " & vbLf & _
"als ersten Wert die Anzahl der Spalten, ab dem zweiten wert die Zahlenreihe.")
arr = Split(strEingabe, ";")
Stufen = UBound(arr) - CLng(arr(0))
strEingabe = Mid(strEingabe, InStr(strEingabe, ";")) & ";"
Cells.Clear
Call Rekursion(strEingabe, 1)
Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
End Sub
Sub Rekursion(ByVal Zahlen As String, ByVal sp As Long)
Dim arrZahlen
Dim Zahlen2 As String
Dim i As Long
arrZahlen = Split(Zahlen, ";")
For i = UBound(arrZahlen) - 1 To 1 Step -1
Zahlen2 = Replace(Zahlen, ";" & arrZahlen(i) & ";", ";")
If sp = Stufen Then
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Mid(Zahlen2, 2, Len(Zahlen2) - 2)
Else
Call Rekursion(Zahlen2, sp + 1)
End If
Next
End Sub
Sid