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_bordersort_border = UBound(arr) - 1  '排序边界，之后为有序，减少循环If mode = "+" ThenFor i = LBound(arr) To UBound(arr)sorted = True    '初始为有序，避免中途有序后的无效循环For j = LBound(arr) To sort_borderIf arr(j) > arr(j + 1) Thensorted = False    '无序temp = arr(j)     '交换数据arr(j) = arr(j + 1): arr(j + 1) = templast_index = j    '最后排序的序号End IfNextsort_border = last_index ': Debug.Print "sort_border", sort_borderIf sorted Then Exit For   '如果为有序，则退出循环NextElseIf mode = "-" ThenFor i = LBound(arr) To UBound(arr)sorted = True    '初始为有序，避免中途有序后的无效循环For j = LBound(arr) To sort_borderIf arr(j) < arr(j + 1) Thensorted = False    '无序temp = arr(j)     '交换数据arr(j) = arr(j + 1): arr(j + 1) = templast_index = j    '最后排序的序号End IfNextsort_border = last_index ': Debug.Print "sort_border", sort_borderIf sorted Then Exit For   '如果为有序，则退出循环NextEnd Ifbubble_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_borderReDim temp(LBound(arr, 2) To UBound(arr, 2))sort_border = UBound(arr) - 1  '排序边界，之后为有序，减少循环If mode = "+" ThenFor i = LBound(arr) To UBound(arr)sorted = True    '初始为有序，避免中途有序后的无效循环For j = LBound(arr) To sort_borderIf arr(j, column) > arr(j + 1, column) Thensorted = 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)Nextlast_index = j    '最后排序的序号End IfNextsort_border = last_index ': Debug.Print "sort_border", sort_borderIf sorted Then Exit For  '如果为有序，则退出循环NextElseIf mode = "-" ThenFor i = LBound(arr) To UBound(arr)sorted = True    '初始为有序，避免中途有序后的无效循环For j = LBound(arr) To sort_borderIf arr(j, column) < arr(j + 1, column) Thensorted = 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)Nextlast_index = j    '最后排序的序号End IfNextsort_border = last_index ': Debug.Print "sort_border", sort_borderIf sorted Then Exit For  '如果为有序，则退出循环NextEnd Ifbubble_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].ValueReDim 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()提取文字前的数字Nextbrr = bubble_sort_arr(arr, 2, "+")  '对"执"之前的内容排序first = 1For j = 1 To UBound(brr) - 1If brr(j, 2) <> brr(j + 1, 2) Then  '对"执"之前的内容相等的排序last = jReDim 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)Nextresult = bubble_sort_arr(crr, 2, "+")write_row = Cells(1, write_col).CurrentRegion.Rows.count + 1Cells(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)Nextresult = bubble_sort_arr(crr, 2, "+")write_row = Cells(1, write_col).CurrentRegion.Rows.count + 1Cells(write_row, write_col).Resize(UBound(result), 1) = result  '仅返回排序后的内容Exit For  '结束循环End Iffirst = last + 1  '重置开始行NextDebug.Print ("排序完成，累计用时" & Format(Now() - tm, "hh:mm:ss"))  '耗时
End Sub

返回结果

参考资料：《冒泡排序》

Excel·VBA数组冒泡排序函数相关推荐

Excel·VBA数组行列转换函数
目录 1,二维数组与一维嵌套数组互相转换函数 2,二维数组转换为指定行数/列数的函数 3,数组行列转置函数 1,二维数组与一维嵌套数组互相转换函数 <Excel·VBA数组组合函数.组合求和&g ...
Excel VBA数组拓展列表(可以用作数据容器)
应用场景: 从数据库获取数据暂存,多表汇总,数据分析等,因为数组是存在于内存的,所以运行速度会非常快. 一.先总结数组的特性数组转置必须在同过程或同函数内redim 否则报无效 redim: 起始 ...
Excel·VBA自定义正则表达式函数、使用
目录正则表达式替换函数应用1,提取1个字母+10个数字应用2,中英文分割应用3,提取11位手机号应用4,指定文字替换应用5,提取最后一个括号的内容应用6,提取所有括号的内容应用7,提取 ...
EXCEL VBA数组使用的一些技巧和总结
数组声明 Dim myArray(1 to 50) as string 声明了一个下界为1,上界为50,类型为string的数组,当省略下界,如Dim myArray(50) as string时,其 ...
Excel·VBA加权求和函数
Function WS(ByVal weight, ByVal data, Optional mode As Boolean = 1)'加权求和函数WS(权重数组, 数值数组, 模式),weight和 ...
【EXCEL VBA】字符函数
s = "ABCDEFG" 1.我想获取字符串s的左边三个字符 Left(s,3)则返回ABC 2.我想获取字符串s的右边三个字符 Right(s,3)则返回EFG ...
Excel·VBA多个日期期间是否重叠、连续
目录多个日期期间是否重叠举例多个日期期间是否连续举例多个日期期间是否重叠 date_startend()函数需要调用排序函数bubble_sort()<Excel·VBA数组冒泡排序函 ...
Excel·VBA多条件筛选组合结果
Function strTOF(str$) As Boolean'用于计算字符串判断True/False,默认返回False'适用vba比较运算符:速度比较慢,但通用Dim i&, j& ...
Excel·VBA自动生成日记账的对方科目
如图:根据日记账/序时账的日期.凭证号为一组,按借贷方向生成相反的科目,并写入H列.可能存在一对一.一对多.多对多等情况的账目目录数组法遍历.判断.写入测试结果多对多问题处理测试结果数组法 ...
详解xlwings包，用Python代替Excel VBA
详解xlwings包,用Python代替Excel VBA <代替VBA! 用Python轻松实现Excel编程>demo 主要内容 Python语法基础 Excel对象模型:OpenPy ...

Excel·VBA数组冒泡排序函数

目录

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

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

举例

Excel·VBA数组冒泡排序函数相关推荐

最新文章

热门文章