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
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
参考资料:《冒泡排序》