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
    3. Sub Main_Sheetsort()
    4. Dim i
    5. Dim wb As Workbook
    6. Set wb = ThisWorkbook
    7. Call create_Sheetarray
    8. Call spur_String_out
    9. Call QuickSort_Sheets(sheetArray, LBound(sheetArray), UBound(sheetArray))
    10. Call spur_String_in
    11. For i = UBound(sheetArray) To 1 Step -1
    12. wb.Sheets(sheetArray(i - 1)).Move before:=wb.Sheets(1)
    13. Next
    14. End Sub
    15. Sub create_Sheetarray()
    16. Dim ws As Worksheet
    17. Dim wb As Workbook
    18. Dim i As Long
    19. Set wb = ThisWorkbook
    20. For Each ws In wb.Sheets
    21. If Left(ws.Name, 5) = "Spur_" Then
    22. ReDim Preserve sheetArray(i)
    23. sheetArray(i) = ws.Name
    24. i = i + 1
    25. End If
    26. Next ws
    27. End Sub
    28. Sub spur_String_out()
    29. Dim i As Long
    30. Dim j As Long
    31. For i = 0 To UBound(sheetArray)
    32. j = Len(sheetArray(i)) - 5
    33. If IsNumeric(Right(sheetArray(i), j)) Then
    34. sheetArray(i) = Right(sheetArray(i), j)
    35. End If
    36. Next i
    37. End Sub
    38. Sub spur_String_in()
    39. Dim i As Long
    40. For i = 0 To UBound(sheetArray)
    41. If IsNumeric(sheetArray(i)) Then
    42. sheetArray(i) = "Spur_" & sheetArray(i)
    43. Debug.Print sheetArray(i)
    44. End If
    45. Next i
    46. End Sub
    47. Sub QuickSort_Sheets(ByRef arrSheets() As Variant, _
    48. ByVal i As Long, _
    49. ByVal j As Long)
    50. Dim x As Long, y As Long
    51. Dim ref As Long, temp As Long
    52. x = i: y = j
    53. ref = arrSheets((x + y) / 2)
    54. Do
    55. Do While arrSheets(x) < ref
    56. x = x + 1
    57. Debug.Print "x = " & x & " ref = " & ref
    58. Loop
    59. Do While arrSheets(y) > ref
    60. y = y - 1
    61. Debug.Print "y = " & y & " ref = " & ref
    62. Loop
    63. If x <= y Then
    64. temp = arrSheets(x)
    65. arrSheets(x) = arrSheets(y)
    66. arrSheets(y) = temp
    67. x = x + 1
    68. y = y - 1
    69. End If
    70. Loop Until (x > y)
    71. If i < y Then Call QuickSort_Sheets(arrSheets, i, y)
    72. If x < j Then Call QuickSort_Sheets(arrSheets, x, j)
    73. 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
    --