Zahlen und Buchstaben schreiben
06.04.2016 04:41:18
Michael
Hi zusammen,
ich glaube, der Betreff war verkehrt: es geht gar nicht ums SORTIEREN, denn sortiert sind die Werte bereits, sondern nur um das spaltenweise schreiben.
Das funktioniert so:
Option Explicit
Private Sub CommandButton1_Click() 'writeNumbers()
Dim intStringPos As Integer
Dim intStringPosEnd As Integer
Dim lngNumberInString As Long, i As Long
Dim strNumber As String, strWert As String, strZwischen As String, Ziffer&
Dim intTrgCol As Integer: intTrgCol = 1
Dim intTrgRow As Integer: intTrgRow = 2
Dim intStep As Integer: intStep = 50
strNumber = .Cells(1, 1)
For intStringPos = 1 To Len(strNumber)
intStringPosEnd = InStr(intStringPos, strNumber, .Cells(1, 2))
If intStringPosEnd = 0 Then Exit Sub
' lngNumberInString = Mid(strNumber, intStringPos, intStringPosEnd - intStringPos)
strWert = LTrim(Mid(strNumber, intStringPos, intStringPosEnd - intStringPos))
strZwischen = ""
For i = 1 To Len(strWert)
Ziffer = Asc(Mid(strWert, i, 1))
If Ziffer > 47 And Ziffer intStep Then
intTrgCol = intTrgCol + 1
intTrgRow = 2
intStep = intStep + 50
End If
.Cells(intTrgRow, intTrgCol) = strWert
intTrgRow = intTrgRow + 1
intStringPos = intStringPosEnd
Next intStringPos
End Sub
Schöne Grüße,
Michael
P.S.: schon mal was von split gehört? Hier das Gleiche nochmal mit Array zur Demonstration:
Option Explicit
Sub writeArray()
Dim intStringPos As Integer
Dim intStringPosEnd As Integer
Dim intTrgCol As Integer: intTrgCol = 1
Dim intTrgRow As Integer: intTrgRow = 2
Dim intStep As Integer: intStep = 50
Dim a As Variant
Dim i&, j&, Ziffer&
Dim strZwischen$
a = Split(Range("A1"), Range("B1"))
For i = LBound(a) To UBound(a)
strZwischen = ""
a(i) = LTrim(a(i))
For j = 1 To Len(a(i))
Ziffer = Asc(Mid(a(i), j, 1))
If Ziffer > 47 And Ziffer "" Then
Ziffer = strZwischen * 1
If Ziffer > intStep Then
intTrgCol = intTrgCol + 1
intTrgRow = 2
intStep = intStep + 50
End If
Cells(intTrgRow, intTrgCol) = a(i)
intTrgRow = intTrgRow + 1
intStringPos = intStringPosEnd
End If
Next
End Sub