Преобразование сортировки восходящего массива в нисходящий VBA - PullRequest
0 голосов
/ 11 января 2020

У меня есть эта функция, которая использует метод медианы трех для сортировки массива одного измерения в VBA, я пытался сделать это для сортировки по убыванию, но почему-то мне не хватает части. Есть ли простой способ добиться этого?

Public Sub MedianThreeQuickSort1Desc(ByRef pvarArray As Variant, _
                                    Optional ByVal plngLeft As Long, _
                                        Optional ByVal plngRight As Long)

    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim lngIndex As Long
    Dim varSwap As Variant
    Dim a As Long
    Dim b As Long
    Dim c As Long

    If plngRight = 0 Then
        plngLeft = LBound(pvarArray)
        plngRight = UBound(pvarArray)
    End If

    lngFirst = plngLeft
    lngLast = plngRight
    lngIndex = plngRight - plngLeft + 1
    a = Int(lngIndex * Rnd) + plngLeft
    b = Int(lngIndex * Rnd) + plngLeft
    c = Int(lngIndex * Rnd) + plngLeft
    If pvarArray(a) <= pvarArray(b) And pvarArray(b) <= pvarArray(c) Then
        lngIndex = b
    Else
        If pvarArray(b) <= pvarArray(a) And pvarArray(a) <= pvarArray(c) Then
            lngIndex = a
        Else
            lngIndex = c
        End If
    End If

    varMid = pvarArray(lngIndex)
    Do
        Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
            lngFirst = lngFirst + 1
        Loop

        Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
            lngLast = lngLast - 1
        Loop

        If lngFirst <= lngLast Then
            varSwap = pvarArray(lngFirst)
            pvarArray(lngFirst) = pvarArray(lngLast)
            pvarArray(lngLast) = varSwap
            lngFirst = lngFirst + 1
            lngLast = lngLast - 1
        End If
    Loop Until lngFirst > lngLast

    If (lngLast - plngLeft) < (plngRight - lngFirst) Then
        If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
        If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
    Else
        If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
        If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
    End If
End Sub

Тестирование sub:

Sub TryIt()
    Dim i As Integer
    Dim arr As Variant

    arr = Array("Apple", "word", 4, "Jack", 521, "123", 1, 2, 3, 0)

    Call MedianThreeQuickSort1(arr)
    For i = 0 To UBound(arr)
        Debug.Print arr(i) & " "
    Next i
End Sub

Вывод:

0 
1 
2 
3 
4 
521 
123 
Apple 
Jack 
word 

1 Ответ

1 голос
/ 14 января 2020

Оказывается, это было не так сложно:

Public Sub MedianThreeQuickSort1_Desc(ByRef pvarArray As Variant, _
                                    Optional ByVal plngLeft As Long, _
                                        Optional ByVal plngRight As Long)

    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim lngIndex As Long
    Dim varSwap As Variant
    Dim a As Long
    Dim b As Long
    Dim c As Long

    If plngRight = 0 Then
        plngLeft = LBound(pvarArray)
        plngRight = UBound(pvarArray)
    End If

    lngFirst = plngLeft
    lngLast = plngRight
    lngIndex = plngRight - plngLeft + 1
    a = Int(lngIndex * Rnd) + plngLeft
    b = Int(lngIndex * Rnd) + plngLeft
    c = Int(lngIndex * Rnd) + plngLeft
    If pvarArray(a) <= pvarArray(b) And pvarArray(b) <= pvarArray(c) Then
        lngIndex = b
    Else
        If pvarArray(b) <= pvarArray(a) And pvarArray(a) <= pvarArray(c) Then
            lngIndex = a
        Else
            lngIndex = c
        End If
    End If

    varMid = pvarArray(lngIndex)
    Do
        Do While pvarArray(lngFirst) > varMid And lngFirst < plngRight
            lngFirst = lngFirst + 1
        Loop

        Do While varMid > pvarArray(lngLast) And lngLast > plngLeft
            lngLast = lngLast - 1
        Loop

        If lngFirst <= lngLast Then
            varSwap = pvarArray(lngLast)
            pvarArray(lngLast) = pvarArray(lngFirst)
            pvarArray(lngFirst) = varSwap
            lngFirst = lngFirst + 1
            lngLast = lngLast - 1
        End If
    Loop Until lngFirst > lngLast

    If (lngLast - plngLeft) < (plngRight - lngFirst) Then
        If plngLeft < lngLast Then MedianThreeQuickSort1_Desc pvarArray, plngLeft, lngLast
        If lngFirst < plngRight Then MedianThreeQuickSort1_Desc pvarArray, lngFirst, plngRight
    Else
        If lngFirst < plngRight Then MedianThreeQuickSort1_Desc pvarArray, lngFirst, plngRight
        If plngLeft < lngLast Then MedianThreeQuickSort1_Desc pvarArray, plngLeft, lngLast
    End If
End Sub

Пример:

Sub TryIt()
    Dim i As Integer
    Dim arr As Variant

    arr = Array("Apple", "word", 4, "Jack", 521, "123", 1, 2, 3, 0)

    Call MedianThreeQuickSort1_Desc(arr)
    For i = 0 To UBound(arr)
        Debug.Print arr(i) & " "
    Next i
End Sub

Выход:

word 
Jack 
Apple 
123 
521 
4 
3 
2 
1 
0 
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...