Excel·VBA数组冒泡排序函数 | 您所在的位置:网站首页 › vba升序排列第一列代码 › Excel·VBA数组冒泡排序函数 |
目录
1,一维数组冒泡排序函数2,二维数组冒泡排序函数单列排序版举例
多列排序版2.1,字符串拼接法2.2,逐步字符串拼接法,数组版2.3,逐步字符串拼接法,字典版3种代码对比
1,一维数组冒泡排序函数
Function bubble_sort(ByVal arr, Optional mode$ = "+")
'函数定义bubble_sort(数组,排序模式)对一维数组数据进行排序,返回一个有序一维数组
'2种排序模式,"+"即升序、"-"即降序
Dim i&, j&, 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 '交换数据
temp = arr(j): arr(j) = arr(j + 1): arr(j + 1) = temp
sorted = False: 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) brr(j + 1, 1) Then
For t = 1 To UBound(brr, 2) '交换数据,数组整行
temp = brr(j, t): brr(j, t) = brr(j + 1, t): brr(j + 1, t) = temp
Next
sorted = False: last_index = j '最后排序的序号
End If
Next
sort_border = last_index
If sorted Then Exit For '如果为有序,则退出循环
Next
Dim kk&, r_s&, r_e&, s$
kk = 2: r_s = 1: r_e = 1: s = brr(1, 1) '当前排序列号;开始、结束行号;开始值
Do While k > 1 And kk = m Then
kk = kk + 1: r_s = 1: r_e = 1
If kk > 2 And kk 2 Then '当前排序列号 >2 时,前2列字符串合并至kk-1列(即kk-2和kk-1合并)
For i = 1 To m
brr(i, kk - 1) = brr(i, kk - 2) & delimiter & brr(i, kk - 1)
Next
End If
For i = 1 To m 'kk-1列值写入字典
temp = brr(i, kk - 1)
If Not dict.Exists(temp) Then
dict(temp) = Array(1, i, i) '计数、开始行号、结束行号
Else
c = dict(temp)(0) + 1: dict(temp) = Array(c, dict(temp)(1), i)
End If
Next
For Each ks In dict.keys
If dict(ks)(0) > 1 Then '有重复值,则需排序
r_s = dict(ks)(1): r_e = dict(ks)(2): sort_border = r_e - 1 '开始行号、结束行号
For i = r_s To r_e
sorted = True
For j = r_s To sort_border
If brr(j, kk) > brr(j + 1, kk) Then
For t = 1 To UBound(brr, 2)
temp = brr(j, t): brr(j, t) = brr(j + 1, t): brr(j + 1, t) = temp
Next
sorted = False: last_index = j
End If
Next
sort_border = last_index
If sorted Then Exit For
Next
End If
Next
kk = kk + 1: dict.RemoveAll
Loop
If mode = "+" Then '写入结果数组
For i = 1 To m
r = brr(i, k + 1) '对应brr排序行号
For j = 1 To n
result(i, j) = arr(r, j)
Next
Next
ElseIf mode = "-" Then
For i = 1 To m
r = brr(m + 1 - i, k + 1)
For j = 1 To n
result(i, j) = arr(r, j)
Next
Next
End If
bubble_sort2d_v2 = result
End Function
3种代码对比
以单列排序版举例为例 Sub bubble_sort2d测试() Dim arr, brr arr = [a2:b19] brr = bubble_sort2d(arr, Array(1, 2)) [d2].Resize(UBound(brr), UBound(brr, 2)) = brr brr = bubble_sort2d_v1(arr, Array(1, 2)) [g2].Resize(UBound(brr), UBound(brr, 2)) = brr brr = bubble_sort2d_v2(arr, Array(1, 2)) [j2].Resize(UBound(brr), UBound(brr, 2)) = brr End Sub2列都是数字文字混合的数据,3种代码排序结果相同 参考资料:《冒泡排序》 |
CopyRight 2018-2019 实验室设备网 版权所有 |