Jestem zaskoczony, jak wolno ten algorytm sortowania bąbelkowego używa VBA. Więc moje pytanie brzmi: czy robię coś złego / nieefektywnego, czy jest to tylko najlepszy VBA i sortowanie bąbelkowe? Na przykład, użycie VARIANTÓW, zbyt wiele zmiennych itp. Może znacznie spowolnić działanie. Wiem, że Bubble Sort nie jest szczególnie szybki, ale nie sądziłem, że będzie tak wolno.

Wejścia algorytmu: tablica 2D i jedna lub dwie kolumny do sortowania, każdy asc lub desc. Niekoniecznie potrzebuję błyskawicznie, ale 30 sekund na 5000 rzędów jest całkowicie nie do przyjęcia

Option Explicit


Sub sortA()

Dim start_time, end_time
start_time = Now()

Dim ThisArray() As Variant
    Dim sheet As Worksheet
    Dim a, b As Integer
    Dim rows, cols As Integer

    Set sheet = ArraySheet
    rows = 5000
    cols = 3
    ReDim ThisArray(0 To cols - 1, 0 To rows - 1)


    For a = 1 To rows
        For b = 1 To cols
            ThisArray(b - 1, a - 1) = ArraySheet.Cells(a, b)
        Next b
    Next a

    Call BubbleSort(ThisArray, 0, False, 2, True)

end_time = Now()
MsgBox (DateDiff("s", start_time, end_time))

End Sub



'Array Must Be: Array(Column,Row)
Sub BubbleSort(ThisArray As Variant, SortColumn1 As Integer, Asc1 As Boolean, Optional SortColumn2 As Integer = -1, Optional Asc2 As Boolean)

    Dim FirstRow As Integer
    Dim LastRow As Integer
    Dim FirstCol As Integer
    Dim LastCol As Integer
    Dim lTemp As Variant
    Dim i, j, k As Integer
    Dim a1, a2, b1, b2 As Variant
    Dim CompareResult As Boolean

    FirstRow = LBound(ThisArray, 2)
    LastRow = UBound(ThisArray, 2)
    FirstCol = LBound(ThisArray, 1)
    LastCol = UBound(ThisArray, 1)

    For i = FirstRow To LastRow
        For j = i + 1 To LastRow

            If SortColumn2 = -1 Then 'If there is only one column to sort by
                a1 = ThisArray(SortColumn1, i)
                a2 = ThisArray(SortColumn1, j)

                If Asc1 = True Then
                    CompareResult = compareOne(a1, a2)
                Else
                    CompareResult = compareOne(a2, a1)
                End If

            Else 'If there are two columns to sort by
                a1 = ThisArray(SortColumn1, i)
                a2 = ThisArray(SortColumn1, j)
                b1 = ThisArray(SortColumn2, i)
                b2 = ThisArray(SortColumn2, j)

                If Asc1 = True Then
                    If Asc2 = True Then
                        CompareResult = compareTwo(a1, a2, b1, b2)
                    Else
                        CompareResult = compareTwo(a1, a2, b2, b1)
                    End If
                Else
                    If Asc2 = True Then
                        CompareResult = compareTwo(a2, a1, b1, b2)
                    Else
                        CompareResult = compareTwo(a2, a1, b2, b1)
                    End If
                End If
            End If

            If CompareResult = True Then ' If compare result returns true, Flip rows
                 For k = FirstCol To LastCol
                     lTemp = ThisArray(k, j)
                     ThisArray(k, j) = ThisArray(k, i)
                     ThisArray(k, i) = lTemp
                 Next k
            End If
        Next j
    Next i

End Sub

Function compareOne(FirstCompare1 As Variant, FirstCompare2 As Variant) As Boolean

    If FirstCompare1 > FirstCompare2 Then
        compareOne = True
    Else
        compareOne = False
    End If

End Function


Function compareTwo(FirstCompare1 As Variant, FirstCompare2 As Variant, SecondCompare1 As Variant, SecondCompare2 As Variant) As Boolean

    If FirstCompare1 > FirstCompare2 Then
        compareTwo = True
    ElseIf FirstCompare1 = FirstCompare2 And SecondCompare1 > SecondCompare2 Then
        compareTwo = True
    Else
        compareTwo = False
    End If

End Function

Dzięki za pomoc i poradę !!

Edytuj: postanowiłem zamiast tego użyć QuickSort. Zobacz post poniżej kodu, jeśli jest zainteresowany.