Excel · VBA array bubble sorting function

1, One dimensional array bubble sorting function

Function bubble_sort(arr, Optional mode As String = "+")
    ' Function definition bubble_sort( Array , Sort mode ) Sort one-dimensional array data , Returns an ordered one-dimensional array 
    '2 Sort mode ,"+" In ascending order 、"-" In descending order 
    Dim i As Long, j As Long, sorted As Boolean, temp, last_index, sort_border
    sort_border = UBound(arr) - 1  ' Sort boundaries , Followed by order , Reduce the cycle 
    If mode = "+" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    ' The initial order is , Avoid invalid loops after ordering in the middle 
            For j = LBound(arr) To sort_border
                If arr(j) > arr(j + 1) Then
                    sorted = False    ' disorder 
                    temp = arr(j)     ' Exchange data 
                    arr(j) = arr(j + 1): arr(j + 1) = temp
                    last_index = j    ' Sequence number of the last sort 
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For   ' If ordered , Then exit the loop 
        Next
    ElseIf mode = "-" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    ' The initial order is , Avoid invalid loops after ordering in the middle 
            For j = LBound(arr) To sort_border
                If arr(j) < arr(j + 1) Then
                    sorted = False    ' disorder 
                    temp = arr(j)     ' Exchange data 
                    arr(j) = arr(j + 1): arr(j + 1) = temp
                    last_index = j    ' Sequence number of the last sort 
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For   ' If ordered , Then exit the loop 
        Next
    End If
    bubble_sort = arr
End Function

2, Bubble sorting function of two-dimensional array

Function bubble_sort_arr(arr, column As Integer, Optional mode As String = "+")
    ' Function definition bubble_sort_arr( Array , Sort columns , Sort mode ) Sort the specified column of two-dimensional array data , Returns an ordered two-dimensional array 
    '2 Sort mode ,"+" In ascending order 、"-" In descending order 
    Dim i As Long, j As Long, t As Long, sorted As Boolean, temp, last_index, sort_border
    ReDim temp(LBound(arr, 2) To UBound(arr, 2))
    sort_border = UBound(arr) - 1  ' Sort boundaries , Followed by order , Reduce the cycle 
    If mode = "+" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    ' The initial order is , Avoid invalid loops after ordering in the middle 
            For j = LBound(arr) To sort_border
                If arr(j, column) > arr(j + 1, column) Then
                    sorted = False    ' disorder 
                    For t = LBound(arr, 2) To UBound(arr, 2)  ' Exchange data , Array entire row 
                        temp(t) = arr(j, t)
                        arr(j, t) = arr(j + 1, t): arr(j + 1, t) = temp(t)
                    Next
                    last_index = j    ' Sequence number of the last sort 
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For  ' If ordered , Then exit the loop 
        Next
    ElseIf mode = "-" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    ' The initial order is , Avoid invalid loops after ordering in the middle 
            For j = LBound(arr) To sort_border
                If arr(j, column) < arr(j + 1, column) Then
                    sorted = False    ' disorder 
                    For t = LBound(arr, 2) To UBound(arr, 2)  ' Exchange data , Array entire row 
                        temp(t) = arr(j, t)
                        arr(j, t) = arr(j + 1, t): arr(j + 1, t) = temp(t)
                    Next
                    last_index = j    ' Sequence number of the last sort 
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For  ' If ordered , Then exit the loop 
        Next
    End If
    bubble_sort_arr = arr
End Function

give an example

《excel Let's ask questions - Sort by number size 》, Due to non-standard data 、 The number of digits of the digital serial number is different , Therefore, we need to segment the data first , Then call function sorting base note
Considering that there may be different years in practical application , So first of all “ Of board ” Sort contents before words , And then separate them from each other “ Of board ” The same content before the word “ Of board ” Sort content after word

Private Sub  Sequencing tests ()
    tm = Now()
    Dim arr, temp, brr, crr, result, i, j, k, first, last, write_col, write_row
'------ Fill in the parameters 
    write_col = "e"         ' Write area , Name , Append to column footer 
    Cells(1, write_col).Value = " title "
    arr = [b2:b19].Value
    ReDim Preserve arr(1 To UBound(arr), 1 To 3)
    For i = 1 To UBound(arr)
        temp = Split(arr(i, 1), " Of board ")
        arr(i, 2) = temp(0): arr(i, 3) = Val(temp(1))  'val() Extract numbers before text 
    Next
    brr = bubble_sort_arr(arr, 2, "+")  ' Yes " Of board " Previous content sorting 
    first = 1
    For j = 1 To UBound(brr) - 1
        If brr(j, 2) <> brr(j + 1, 2) Then  ' Yes " Of board " The previous contents are sorted equally 
            last = j
            ReDim crr(1 To last - first + 1, 1 To 2)
            For k = first To last    ' Array truncation 
                crr(k - first + 1, 1) = brr(k, 1): crr(k - first + 1, 2) = brr(k, 3)
            Next
            result = bubble_sort_arr(crr, 2, "+")
            write_row = Cells(1, write_col).CurrentRegion.Rows.count + 1
            Cells(write_row, write_col).Resize(UBound(result), 1) = result  ' Returns only the sorted content 
        ElseIf j = UBound(brr) - 1 Then  ' The last set of data , No matter single line or multiple lines 
            last = UBound(brr)
            ReDim crr(1 To last - first + 1, 1 To 2)
            For k = first To last    ' Array truncation 
                crr(k - first + 1, 1) = brr(k, 1): crr(k - first + 1, 2) = brr(k, 3)
            Next
            result = bubble_sort_arr(crr, 2, "+")
            write_row = Cells(1, write_col).CurrentRegion.Rows.count + 1
            Cells(write_row, write_col).Resize(UBound(result), 1) = result  ' Returns only the sorted content 
            Exit For  ' End of cycle 
        End If
        first = last + 1  ' Reset start line 
    Next
    Debug.Print (" Sort complete , Accumulated time " & Format(Now() - tm, "hh:mm:ss"))  ' Time consuming 
End Sub

Return results

Reference material ：《 Bubble sort 》