Sortowanie bąbelkowe odbywa się w tablicy – niestety nie pamiętam źródła kodu. Dość często używałem tego sortowania, ale niedawno odkryłem że lepiej wykorzystać wbudowane funkcje Excela, aby przyspieszyć wykonanie kodu w aplikacji.

Sortowanie bąbelkowe pomimo swoich zalet, przy dużej ilości danych jest dość powolne. Każdy kto będzie chciał rozszerzyć wiedzę o tym sortowaniu spokojnie znajdzie potrzebne informacje w internecie.

Poniższy kod sortuje wartości od najmniejszej do największej, w kolumnie A zaczynając do wiersza 1 trzeba wpisać jakieś wartości liczbowe:

Sub SortowanieBabelkowe()

Dim InputTablica()
Dim ArrayLevel, LicznikWierszy, i As Long
Dim TheArray()

With ThisWorkbook.Sheets("Sheet1")
    ' Dodawanie wartości do tablicy
    LicznikWierszy = 1
    Do Until .Cells(LicznikWierszy, 1) = ""
        If ThisWorkbook.Sheets("Sheet1").Cells(LicznikWierszy, 1) <> "" Then
            ' Znaleziono wartość - dodanie jej do tablicy
            ReDim Preserve InputTablica(ArrayLevel)
            InputTablica(ArrayLevel) = .Cells(LicznikWierszy, 1)
            ArrayLevel = ArrayLevel + 1
        Else
            ' w komórce nie ma żadnych danych nic sie nie dzieje
        End If
    LicznikWierszy = LicznikWierszy + 1
    Loop

    ' Create the array.
    TheArray = InputTablica
    ' Sort the Array and display the values in order.
    BubbleSort TheArray
    
    For i = 0 To UBound(TheArray)
        If TheArray(i) <> "" Then
            .Cells(i + 1, 2) = TheArray(i)
        End If
    Next i
End With

End Sub

Function BubbleSort(TempArray As Variant)
' Sortowanie babelkowe

Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer

' Loop until no more "exchanges" are made.
Do
    NoExchanges = True
    ' Loop through each element in the array.
    For i = 1 To UBound(TempArray) - 1
        ' If the element is greater than the element following it, exchange the two elements.
        If TempArray(i) > TempArray(i + 1) Then
            NoExchanges = False
            Temp = TempArray(i)
            TempArray(i) = TempArray(i + 1)
            TempArray(i + 1) = Temp
        End If
    Next i
Loop While Not (NoExchanges)
End Function