Quicksort mit mehreren Sortierschlüsseln

Hallo Excelkollegen,
ich habe eine Quicksortroutine, die 2-dimensionale Arrays nach dem angegebenen Sortierschlüssel sortiert.
Wie kann ich die Routine erweitern, um 2 oder 3 Sortierschlüssel zu ermöglichen ?
Danke Stefan.
Public


Sub Quicksort(vntFeld As Variant, _
ByVal lngOrder As Long, _
Optional ByVal lngUGrenze As Long = -1, _
Optional ByVal lngOGrenze As Long = -1)
' geändert Stefan Krähe / 06.09.2005
' Sortiert ein 2D-Array
' 1. Dimension enthält die Felder und 2. Dimension die Datensätze
' Sortiert innerhalb der 2. Dimension
Dim lngUIndex As Long
Dim lngOIndex As Long
Dim lngHelpIndex As Long
Dim vntElement As Variant
Dim strSort As String
Dim varBuffer As Variant
'Initialisierung
If lngUGrenze = -1 Then lngUGrenze = LBound(vntFeld, 2)
If lngOGrenze = -1 Then lngOGrenze = UBound(vntFeld, 2)
lngUIndex = lngUGrenze
lngOIndex = lngOGrenze
'Vergleichselemente lesen
vntElement = vntFeld(lngOrder, (lngUIndex + lngOIndex) / 2)
Do
Do While vntFeld(lngOrder, lngUIndex) < vntElement
lngUIndex = lngUIndex + 1
Loop
Do While vntFeld(lngOrder, lngOIndex) > vntElement
lngOIndex = lngOIndex - 1
Loop
If lngUIndex <= lngOIndex Then
'Elemente tauschen
For lngHelpIndex = LBound(vntFeld, 1) To UBound(vntFeld, 1)
varBuffer = vntFeld(lngHelpIndex, lngUIndex)
vntFeld(lngHelpIndex, lngUIndex) = vntFeld(lngHelpIndex, lngOIndex)
vntFeld(lngHelpIndex, lngOIndex) = varBuffer
Next lngHelpIndex
lngUIndex = lngUIndex + 1
lngOIndex = lngOIndex - 1
End If
Loop Until (lngUIndex > lngOIndex)
'Iterativ durchlaufen
If lngUGrenze < lngOIndex Then Call Quicksort(vntFeld, lngOrder, lngUGrenze, lngOIndex)
If lngUIndex < lngOGrenze Then Call Quicksort(vntFeld, lngOrder, lngUIndex, lngOGrenze)
End Sub

Hallo Stefan,
eine zweite Routine würde die erste Sortierfolge wieder zerstören. Ich habe eine Routine die du dir aber auf dein Array anpassen musst. Das Makro sortiert in Zeilen. Dein Array besteht nur aus vier Zeilen und n Spalten. Den Unterschied kannst du mit diesen zwei kleinen Makros sehen:
Public Sub test1()
    Dim a(1 To 2, 1 To 10) As Integer
    Range("A1:B10") = a
End Sub

Public Sub test2()
    Dim a(1 To 2, 1 To 10) As Integer
    Range("A1:J2") = a
End Sub

Die Sortierroutine mit einem kleinen Testmakro:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Const MAX_COUNT = 9999&

Public Sub prctest()
    Dim vntArray(MAX_COUNT, 2) As Variant
    Dim bytSortkey(2) As Byte
    Dim strSortOrder As String

    Dim lngIndex As Long
    For lngIndex = 0 To MAX_COUNT
        vntArray(lngIndex, 0) = Int((100 * Rnd) + 1)
        vntArray(lngIndex, 1) = Int((100 * Rnd) + 1)
        vntArray(lngIndex, 2) = Int((100 * Rnd) + 1)
    Next

    bytSortkey(0) = 1 'Spalte 1. Kriterium
    bytSortkey(1) = 2 'Spalte 2. Kriterium
    bytSortkey(2) = 0 'Spalte 3. Kriterium

    strSortOrder = "001" '1 absteigend / 0 aufsteigend

    Call prcQuickSort(LBound(vntArray), UBound(vntArray), 2, _
        bytSortkey(), strSortOrder, vntArray())

    Range(Cells(1, 1), Cells(MAX_COUNT + 1, 3)) = vntArray

End Sub

Private Sub prcQuickSort(lngLBound As Long, lngUBound As Long, _
        bytColumns As Byte, bytSortkey() As Byte, _
        strSortOrder As String, vntArray() As Variant)
    Dim lngIndex1 As Long, lngIndex2 As Long
    Dim vntBuffer() As Variant, vntTemp As Variant
    Dim bytIndex As Byte, bytSortKeys As Byte
    Redim vntBuffer(UBound(bytSortkey)) As Variant
    lngIndex1 = lngLBound
    lngIndex2 = lngUBound
    For bytIndex = 0 To UBound(bytSortkey)
        vntBuffer(bytIndex) = vntArray((lngLBound + lngUBound) \ 2, _
            bytSortkey(bytIndex))
    Next
    Do
        Select Case UBound(bytSortkey)
            Case 0
                Select Case strSortOrder
                    Case "0"
                        Do While vntArray(lngIndex1, bytSortkey(0)) < vntBuffer(0)
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) < vntArray(lngIndex2, bytSortkey(0))
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "1"
                        Do While vntArray(lngIndex1, bytSortkey(0)) > vntBuffer(0)
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) > vntArray(lngIndex2, bytSortkey(0))
                            lngIndex2 = lngIndex2 - 1
                        Loop
                End Select
            Case 1
                Select Case strSortOrder
                    Case "00"
                        Do While vntArray(lngIndex1, bytSortkey(0)) <= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) >= vntBuffer(1) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) <= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) >= vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "10"
                        Do While vntArray(lngIndex1, bytSortkey(0)) >= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) >= vntBuffer(1) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) >= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) >= vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "01"
                        Do While vntArray(lngIndex1, bytSortkey(0)) <= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) <= vntBuffer(1) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) <= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) <= vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "11"
                        Do While vntArray(lngIndex1, bytSortkey(0)) >= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) <= vntBuffer(1) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) >= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) <= vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                End Select
            Case 2
                Select Case strSortOrder
                    Case "000"
                        Do While vntArray(lngIndex1, bytSortkey(0)) <= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) > vntBuffer(1) _
                                Then Exit Do
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) = vntBuffer(1) And _
                                vntArray(lngIndex1, bytSortkey(2)) >= vntBuffer(2) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) <= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) > vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) = vntArray(lngIndex2, bytSortkey(1)) And _
                                vntBuffer(2) >= vntArray(lngIndex2, bytSortkey(2)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "100"
                        Do While vntArray(lngIndex1, bytSortkey(0)) >= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) > vntBuffer(1) _
                                Then Exit Do
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) = vntBuffer(1) And _
                                vntArray(lngIndex1, bytSortkey(2)) >= vntBuffer(2) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) >= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) > vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) = vntArray(lngIndex2, bytSortkey(1)) And _
                                vntBuffer(2) >= vntArray(lngIndex2, bytSortkey(2)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "010"
                        Do While vntArray(lngIndex1, bytSortkey(0)) <= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) < vntBuffer(1) _
                                Then Exit Do
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) = vntBuffer(1) And _
                                vntArray(lngIndex1, bytSortkey(2)) >= vntBuffer(2) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) <= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) < vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) = vntArray(lngIndex2, bytSortkey(1)) And _
                                vntBuffer(2) >= vntArray(lngIndex2, bytSortkey(2)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "001"
                        Do While vntArray(lngIndex1, bytSortkey(0)) <= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) > vntBuffer(1) _
                                Then Exit Do
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) = vntBuffer(1) And _
                                vntArray(lngIndex1, bytSortkey(2)) <= vntBuffer(2) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) <= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) > vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) = vntArray(lngIndex2, bytSortkey(1)) And _
                                vntBuffer(2) <= vntArray(lngIndex2, bytSortkey(2)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "110"
                        Do While vntArray(lngIndex1, bytSortkey(0)) >= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) < vntBuffer(1) _
                                Then Exit Do
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) = vntBuffer(1) And _
                                vntArray(lngIndex1, bytSortkey(2)) >= vntBuffer(2) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) >= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) < vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) = vntArray(lngIndex2, bytSortkey(1)) And _
                                vntBuffer(2) >= vntArray(lngIndex2, bytSortkey(2)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "011"
                        Do While vntArray(lngIndex1, bytSortkey(0)) <= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) < vntBuffer(1) _
                                Then Exit Do
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) = vntBuffer(1) And _
                                vntArray(lngIndex1, bytSortkey(2)) <= vntBuffer(2) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) <= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) < vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) = vntArray(lngIndex2, bytSortkey(1)) And _
                                vntBuffer(2) <= vntArray(lngIndex2, bytSortkey(2)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "101"
                        Do While vntArray(lngIndex1, bytSortkey(0)) >= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) > vntBuffer(1) _
                                Then Exit Do
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) = vntBuffer(1) And _
                                vntArray(lngIndex1, bytSortkey(2)) <= vntBuffer(2) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) >= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) > vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) = vntArray(lngIndex2, bytSortkey(1)) And _
                                vntBuffer(2) <= vntArray(lngIndex2, bytSortkey(2)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                    Case "111"
                        Do While vntArray(lngIndex1, bytSortkey(0)) >= vntBuffer(0)
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) < vntBuffer(1) _
                                Then Exit Do
                            If vntArray(lngIndex1, bytSortkey(0)) = vntBuffer(0) And _
                                vntArray(lngIndex1, bytSortkey(1)) = vntBuffer(1) And _
                                vntArray(lngIndex1, bytSortkey(2)) <= vntBuffer(2) _
                                Then Exit Do
                            lngIndex1 = lngIndex1 + 1
                        Loop
                        Do While vntBuffer(0) >= vntArray(lngIndex2, bytSortkey(0))
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) < vntArray(lngIndex2, bytSortkey(1)) _
                                Then Exit Do
                            If vntBuffer(0) = vntArray(lngIndex2, bytSortkey(0)) And _
                                vntBuffer(1) = vntArray(lngIndex2, bytSortkey(1)) And _
                                vntBuffer(2) <= vntArray(lngIndex2, bytSortkey(2)) _
                                Then Exit Do
                            lngIndex2 = lngIndex2 - 1
                        Loop
                End Select
        End Select
        If lngIndex1 <= lngIndex2 Then
            For bytIndex = 0 To bytColumns
                vntTemp = vntArray(lngIndex1, bytIndex)
                vntArray(lngIndex1, bytIndex) = vntArray(lngIndex2, bytIndex)
                vntArray(lngIndex2, bytIndex) = vntTemp
            Next
            lngIndex1 = lngIndex1 + 1
            lngIndex2 = lngIndex2 - 1
        End If
    Loop Until lngIndex1 > lngIndex2
    If lngLBound < lngIndex2 Then Call prcQuickSort(lngLBound, lngIndex2, _
        bytColumns, bytSortkey(), strSortOrder, vntArray())
    If lngIndex1 < lngUBound Then Call prcQuickSort(lngIndex1, lngUBound, _
        bytColumns, bytSortkey(), strSortOrder, vntArray())
End Sub

Gruß
Nepumuk
Excel & VBA Beispiele

Quicksort mit mehreren Sortierschlüsseln

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Quicksort mit mehreren Sortierschlüsseln

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread