Excel·VBA数组冒泡排序函数

1，一维数组冒泡排序函数

Function bubble_sort(arr, Optional mode As String = "+")
    '函数定义bubble_sort(数组，排序模式)对一维数组数据进行排序，返回一个有序一维数组
    '2种排序模式，"+"即升序、"-"即降序
    Dim i As Long, j As Long, sorted As Boolean, temp, last_index, sort_border
    sort_border = UBound(arr) - 1  '排序边界，之后为有序，减少循环
    If mode = "+" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    '初始为有序，避免中途有序后的无效循环
            For j = LBound(arr) To sort_border
                If arr(j) > arr(j + 1) Then
                    sorted = False    '无序
                    temp = arr(j)     '交换数据
                    arr(j) = arr(j + 1): arr(j + 1) = temp
                    last_index = j    '最后排序的序号
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For   '如果为有序，则退出循环
        Next
    ElseIf mode = "-" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    '初始为有序，避免中途有序后的无效循环
            For j = LBound(arr) To sort_border
                If arr(j) < arr(j + 1) Then
                    sorted = False    '无序
                    temp = arr(j)     '交换数据
                    arr(j) = arr(j + 1): arr(j + 1) = temp
                    last_index = j    '最后排序的序号
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For   '如果为有序，则退出循环
        Next
    End If
    bubble_sort = arr
End Function

2，二维数组冒泡排序函数

Function bubble_sort_arr(arr, column As Integer, Optional mode As String = "+")
    '函数定义bubble_sort_arr(数组，排序列，排序模式)对二维数组数据的指定列进行排序，返回一个有序二维数组
    '2种排序模式，"+"即升序、"-"即降序
    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  '排序边界，之后为有序，减少循环
    If mode = "+" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    '初始为有序，避免中途有序后的无效循环
            For j = LBound(arr) To sort_border
                If arr(j, column) > arr(j + 1, column) Then
                    sorted = False    '无序
                    For t = LBound(arr, 2) To UBound(arr, 2)  '交换数据，数组整行
                        temp(t) = arr(j, t)
                        arr(j, t) = arr(j + 1, t): arr(j + 1, t) = temp(t)
                    Next
                    last_index = j    '最后排序的序号
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For  '如果为有序，则退出循环
        Next
    ElseIf mode = "-" Then
        For i = LBound(arr) To UBound(arr)
            sorted = True    '初始为有序，避免中途有序后的无效循环
            For j = LBound(arr) To sort_border
                If arr(j, column) < arr(j + 1, column) Then
                    sorted = False    '无序
                    For t = LBound(arr, 2) To UBound(arr, 2)  '交换数据，数组整行
                        temp(t) = arr(j, t)
                        arr(j, t) = arr(j + 1, t): arr(j + 1, t) = temp(t)
                    Next
                    last_index = j    '最后排序的序号
                End If
            Next
            sort_border = last_index ': Debug.Print "sort_border", sort_border
            If sorted Then Exit For  '如果为有序，则退出循环
        Next
    End If
    bubble_sort_arr = arr
End Function

举例

《excel吧提问-按数字大小排序》，由于数据不规范、数字序号的位数不同，因此需要先对数据进行分割，然后调用函数排序
考虑到实际应用中可能存在不同年度，因此先对“执”字之前的内容排序，再分别对“执”字之前同样内容的“执”字之后的内容排序

Private Sub 排序测试()
    tm = Now()
    Dim arr, temp, brr, crr, result, i, j, k, first, last, write_col, write_row
'------参数填写
    write_col = "e"         '写入区域，列名，附加在列尾
    Cells(1, write_col).Value = "标题"
    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), "执")
        arr(i, 2) = temp(0): arr(i, 3) = Val(temp(1))  'val()提取文字前的数字
    Next
    brr = bubble_sort_arr(arr, 2, "+")  '对"执"之前的内容排序
    first = 1
    For j = 1 To UBound(brr) - 1
        If brr(j, 2) <> brr(j + 1, 2) Then  '对"执"之前的内容相等的排序
            last = j
            ReDim crr(1 To last - first + 1, 1 To 2)
            For k = first To last    '数组截取
                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  '仅返回排序后的内容
        ElseIf j = UBound(brr) - 1 Then  '最后一组数据，无论单行多行
            last = UBound(brr)
            ReDim crr(1 To last - first + 1, 1 To 2)
            For k = first To last    '数组截取
                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  '仅返回排序后的内容
            Exit For  '结束循环
        End If
        first = last + 1  '重置开始行
    Next
    Debug.Print ("排序完成，累计用时" & Format(Now() - tm, "hh:mm:ss"))  '耗时
End Sub

返回结果

参考资料：《冒泡排序》