AW: String-Spezialsortierung
07.10.2009 14:34:58
chris
Hallo Erich,
danke noch mal für dein beispiel.
ich habe es jetzt einmal versucht zu erklären was ich leider ohne Hilfe nicht hin bekomme:(
Ich habe in deinen Code eingefügt wie du ´Die strq erstellst mit der das sortieren klappt.
Und wie ich die Strq erstelle mit der dasnicht klappt.
Könntest du mir sagen wie ich das umbauen muss das es auch mit meine Strq klappt ?
Wäre echt super Erich.
Danke
Option Explicit
Sub SortiereString2()
Dim Bereich As Range
Dim meAr, tempAr(), TextAr
Dim A As Long, AA As Long
Dim arrW, strQ As String
' hier wird deine Beispiel-String strQ erstellt --- mit der es klappt das ganze sortieren
Set Bereich = Range("A1", Cells(Rows.Count, 1).End(xlUp))
arrW = Application.Transpose(Bereich.Value2)
strQ = Join(arrW, Chr(10))
'hier wird meine strq erstellt --- hier wird meine strq erstellt mit der das Leider nicht _
klappt (
For xx = 23 To 33
If MyWorkbook_test_User.Worksheets("daten_").Cells(ZeileDb, xx) "" Then
strQ = strQ & Chr(10) & MyWorkbook_test_User.Worksheets("daten_").Cells(Zeile_Db, _
xx)
Else
End If
Next
' ab hier wird strQ umsortiert
meAr = Split(strQ, Chr(10))
ReDim tempAr(0 To UBound(meAr), 1 To 1)
For A = LBound(meAr) To UBound(meAr)
If InStr(meAr(A), " ") > 0 Then
TextAr = Split(meAr(A), " ")
For AA = LBound(TextAr) To UBound(TextAr)
If AA + 1 > UBound(tempAr, 2) Then _
ReDim Preserve tempAr(0 To UBound(tempAr), 1 To AA + 1)
tempAr(A, AA + 1) = TextAr(AA)
Next AA
End If
Next A
prcQuickSort LBound(tempAr), UBound(tempAr), 3, True, tempAr
For A = 0 To UBound(tempAr)
meAr(A) = Empty
For AA = 1 To UBound(tempAr, 2)
meAr(A) = meAr(A) & tempAr(A, AA) & " "
Next AA
If Right$(meAr(A), 1) = " " Then meAr(A) = Left$(meAr(A), Len(meAr(A)) - 1)
Next A
strQ = Join(meAr, Chr(10)) ' strQ ist sortiert
Cells(1, 5) = strQ
End Sub