ArrayList.Sort u. QuickSort sortieren nicht...

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von Petersilie.

    ArrayList.Sort u. QuickSort sortieren nicht...

    Thema erledigt...

    Problem war: Tabllen mit namen "Spur_" & irgendeiner Zahl, zu sortieren.
    Bei ArrayList.Sort hat er falsch sortiert, mein Quicksort hat vorhin auch falsch sortiert.

    Falls ihr also Tabellen mit nummern sortieren wollt, steht unten der Code für euch.
    Die Subs spur_String_out und spur_String_in, sind dafür da den "Spur_" Teil zu entfernen, so dass man nur noch Zahlen hat.

    Mit diesem Quicksort macht er es: (mit arraylist.sort nicht, bei zweistelligen zahlen prüft er bei .sort nur die erste stelle)

    Visual Basic-Quellcode

    1. Option Explicit
    2. Private sheetArray() As Variant
    4. Sub Main_Sheetsort()
    5. Dim i
    6. Dim wb As Workbook
    8. Set wb = ThisWorkbook
    10. Call create_Sheetarray
    11. Call spur_String_out
    12. Call QuickSort_Sheets(sheetArray, LBound(sheetArray), UBound(sheetArray))
    13. Call spur_String_in
    15. For i = UBound(sheetArray) To 1 Step -1
    16. wb.Sheets(sheetArray(i - 1)).Move before:=wb.Sheets(1)
    17. Next
    19. End Sub
    21. Sub create_Sheetarray()
    22. Dim ws As Worksheet
    23. Dim wb As Workbook
    24. Dim i As Long
    26. Set wb = ThisWorkbook
    27. For Each ws In wb.Sheets
    28. If Left(ws.Name, 5) = "Spur_" Then
    29. ReDim Preserve sheetArray(i)
    30. sheetArray(i) = ws.Name
    31. i = i + 1
    32. End If
    33. Next ws
    35. End Sub
    37. Sub spur_String_out()
    38. Dim i As Long
    39. Dim j As Long
    41. For i = 0 To UBound(sheetArray)
    42. j = Len(sheetArray(i)) - 5
    43. If IsNumeric(Right(sheetArray(i), j)) Then
    44. sheetArray(i) = Right(sheetArray(i), j)
    45. End If
    46. Next i
    48. End Sub
    50. Sub spur_String_in()
    51. Dim i As Long
    53. For i = 0 To UBound(sheetArray)
    54. If IsNumeric(sheetArray(i)) Then
    55. sheetArray(i) = "Spur_" & sheetArray(i)
    56. Debug.Print sheetArray(i)
    57. End If
    58. Next i
    60. End Sub
    62. Sub QuickSort_Sheets(ByRef arrSheets() As Variant, _
    63. ByVal i As Long, _
    64. ByVal j As Long)
    66. Dim x As Long, y As Long
    67. Dim ref As Long, temp As Long
    69. x = i: y = j
    70. ref = arrSheets((x + y) / 2)
    72. Do
    73. Do While arrSheets(x) < ref
    74. x = x + 1
    75. Debug.Print "x = " & x & " ref = " & ref
    76. Loop
    78. Do While arrSheets(y) > ref
    79. y = y - 1
    80. Debug.Print "y = " & y & " ref = " & ref
    81. Loop
    83. If x <= y Then
    84. temp = arrSheets(x)
    85. arrSheets(x) = arrSheets(y)
    86. arrSheets(y) = temp
    88. x = x + 1
    89. y = y - 1
    90. End If
    91. Loop Until (x > y)
    93. If i < y Then Call QuickSort_Sheets(arrSheets, i, y)
    94. If x < j Then Call QuickSort_Sheets(arrSheets, x, j)
    96. End Sub


    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Petersilie“ ()

    Kann man machen.
    Nur ich hätte es weniger kompliziert gelöst:

    Visual Basic-Quellcode

    1. ​Option Explicit
    2. Sub SortSheets()
    3. Dim ws1 As Worksheet, ws2 As Worksheet, Nr As Integer
    4. For Each ws1 In ThisWorkbook.Sheets
    5. Nr = Number(ws1.Name)
    6. If Nr > 0 Then
    7. For Each ws2 In ThisWorkbook.Sheets
    8. If Nr > Number(ws2.Name) Then
    9. ws1.Move after:=ws2
    10. End If
    11. Next
    12. End If
    13. Next
    14. End Sub
    15. Function Number(SheetName As String) As Integer
    16. Const Prefix = "Spur_"
    17. If SheetName Like Prefix & "#*" Then Number = Val(Mid(SheetName, Len(Prefix) + 1))
    18. End Function
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --