-
堆排序(使用VBA实现)
2021-04-15 14:25:31堆排序(使用VBA实现) 大根堆,即父节点大于等于其子节点,但左、右子节点大小不考虑。 堆排序的主体思路为:从最后一个父节点开始,调整将该节点调整为大根堆,然后调整上一个父节点为大根堆,最终将首个父节点为...堆排序(使用VBA实现)
大根堆,即父节点大于等于其子节点,但左、右子节点大小不考虑。
堆排序的主体思路为:从最后一个父节点开始,调整将该节点调整为大根堆,然后调整上一个父节点为大根堆,最终将首个父节点为大根堆。所以最大的值即为首个父节点。首个父节点与最后一个节点相调换,最值被放到最后一个节点,循环,最终完成排序。
在进行排序之前,首先需要确定的是最后一个父节点、每父节点对应的左子节点和右子节点的下标。
假设一个数组arr(),其上边界为L,下边界为H,父节点对应的下标为dad,两个子节点下标分别为left_son和right_son,最后一个父节点的下标为last_dad,则有如下关系:
L=lbound(arr)
H=ubound(arr)
left_son=2dad+1-L
right_son=left_son+1=2dad+2-L
last_dad=(L+H-1)/2代码如下:
Sub AdjustMaxHeap(ByRef arr() As Long, indx_start As Long, arrLen As Long) //函数的主要功能为从index_start节点为起点,调整为大根堆 Dim dad As Long Dim son As Long Dim left_son As Long Dim righ_son As Long Dim L As Long: L = LBound(arr) dad = indx_start //last dad left_son = 2 * dad + 1 - L right_son = left_son + 1 son = left_son Do While (son <= arrLen) right_son = left_son + 1 If right_son <= arrLen Then If arr(left_son) < arr(right_son) Then //可以使用具体函数进行比较 son = right_son End If End If If son <= arrLen Then If arr(dad) < arr(son) Then Dim t As Long //swap start t = arr(dad) arr(dad) = arr(son) arr(son) = t //swap end dad = son //vital left_son = 2 * dad + 1 - L son = left_son Else GoTo exitLoop End If End If Loop exitLoop: End Sub Sub heapSort(ByRef arr() As Long) Dim i As Long Dim L As Long Dim H As Long L = LBound(arr) H = UBound(arr) Dim last_dad As Long: last_dad = (L + H - 1) / 2 //首次,将整个树调整为大根堆 For i = last_dad To L Step -1 AdjustMaxHeap arr, i, H Next i Dim t As Long t = arr(H) arr(H) = arr(L) arr(L) = t For i = H - 1 To L Step -1 //因为只是将首节点和根节点调换,其他父节点不受影响,所以只需从首节点处 //将整个树调整为大根堆 AdjustMaxHeap arr, L, i //swap(首节点,尾节点) t = arr(L) arr(L) = arr(i) arr(i) = t Next i End Sub Sub main() Dim arr() As Long ReDim arr(1 To 60000) As Long For i = 1 To 60000 arr(i) = 60001 - i Next i heapSort arr For i = 1 To 60000 Sheets(1).Cells(i, 2) = arr(i) Next i End Sub
-
不确定大小的数组_VBA学习笔记21:数组3
2020-12-10 05:57:071、数组的大小数组是用编号排序的,那么如何获得一个数组的大小呢?——表示数组大小的函数:Lbound(数组) 可以获取数组的最小下标(编号)Ubound(数组) 可以获取数组的最大上标(编号)Ubound(数组,1) 可以获得数组的行...学习资源:《Excel VBA从入门到进阶》第22集 by兰色幻想
这集视频学习的是数组的空间。
1、数组的大小
数组是用编号排序的,那么如何获得一个数组的大小呢?
——表示数组大小的函数:
- Lbound(数组) 可以获取数组的最小下标(编号)
- Ubound(数组) 可以获取数组的最大上标(编号)
- Ubound(数组,1) 可以获得数组的行方面(第1维)最大上标
- Ubound(数组,2) 可以获得数组的列方向(第2维)的最大上标
2、动态数组的动态扩充
如果一个数组无法或不方便计算出总的大小,而在一些特殊情况下又不允许有空位。这时我们就需要用动态的导入方法。
ReDim Preserve arr() 可以声明一个动态大小的数组,而且可以保留原来的数值,就相当于厂房小了,可以改扩建增大,但是它只能让最未维实现动态。如果是一维不存在最未维,只有一维;如果是二维数组的话就只能重新声明第二维。
注意和ReDim arr()区分,如果在这里误用了ReDim arr(),会清空原数组内容。
例1:获取大于30数字的数据作为下拉菜单的数据源。
Private Sub ComboBox1_GotFocus() '使用工作簿事件,数据源发生了变化,下拉菜单也会自动跟着变化,不用手动运行程序更新。 Dim arr(), x, arr1, k arr1 = Range("a1:a10") For x = 1 To UBound(arr1) '如果arr1的数据大于30,k+1,重新声明数组arr大小,并把该数字放入arr If arr1(x, 1) > 30 Then k = k + 1 ReDim Preserve arr(1 To k) arr(k) = arr1(x, 1) End If Next x ComboBox1.List = arr End Sub
结果展示1 结果展示2:数据源发生变化 例2:读取下表中产品B的数据放入B10单元格。
Sub d7() Dim arr, arr1() Dim x, k arr = Range("B2:E7") For x = 1 To UBound(arr) If arr(x, 1) = "B" Then k = k + 1 '二维数组只能声明最后一维的大小,即列数 '我们能确定的是数据有4列,不知道有几行 '但行数不能改变,只能改变列,所以就把数据反过来放入数组 ReDim Preserve arr1(1 To 4, 1 To k) arr1(1, k) = arr(x, 1) arr1(2, k) = arr(x, 2) arr1(3, k) = arr(x, 3) arr1(4, k) = arr(x, 4) End If Next x '因为读入数组的是4行2列,但实际数据是2行4列,需要把数组转置一下再放入单元格。 Range("B10").Resize(k, 4) = Application.Transpose(arr1) End Sub
结果展示:
如果觉得二维数组逐次声明大小很麻烦,可以先把数组定义得足够大:
Sub d8() Dim x, k Dim arr, arr1(1 To 100000, 1 To 4) arr = Range("a1:d6") For x = 1 To UBound(arr) If arr(x, 1) = "B" Then k = k + 1 arr1(k, 1) = arr(x, 1) arr1(k, 2) = arr(x, 2) arr1(k, 3) = arr(x, 3) arr1(k, 4) = arr(x, 4) End If Next x '只把扩充的K行4列填充到指定地点,不管数组大小。 Range("a15").Resize(k, 4) = arr1 End Sub
3、清空数组
使用earse语句。
例:A列数据转化为D:F列样式。
思路分析:
- 把A列连续数据依次放入数组arr1。
- arr读入arr1不为空的数据,遇到数据为空,停止读入arr1;把arr依次写入D列单元格,写入完毕后清空arr内容,并跳到下一列。
- 继续写入arr1不为空数据,放入E列。
按此逻辑重复循环以上三步,直到把arr1读写完毕。
Sub d9() Dim arr, arr1(1 To 1000, 1 To 1) Dim x, m, k arr = Range("a1:a16") For x = 1 To UBound(arr) If arr(x, 1) <> "" Then k = k + 1 arr1(k, 1) = arr(x, 1) Else m = m + 1 Range("c1").Offset(0, m).Resize(k) = arr1 Erase arr1 k = 0 End If Next x End Sub
-
日常使用------利用VbA对Excel中的多个sheet工作表排序
2018-07-19 16:09:18在excel工作簿中对有多个工作表,由于个人需要,对每个工作表中某一值的比较大小后,然后进行排序。 由于vba中字典对应值比较难以排序,所以就分为两步 第一步是提取工作表名和对应字段写到工作表中: Sub ...在excel工作簿中对有多个工作表,由于个人需要,对每个工作表中某一值的比较大小后,然后进行排序。
由于vba中字典对应值比较难以排序,所以就分为两步
第一步是提取工作表名和对应字段写到工作表中:
Sub getname() Dim sheet As Worksheet Dim k As Integer k = 17 For Each sheet In Worksheets Cells(k, 1) = sheet.Name Cells(k, 2) = sheet.Cells(2, 3) k = k + 1 Next End Sub
得到后排序:
再利用第二个函数对排序后的工作表名进行相应的移动:
Sub sortmysheet() Dim sheet As Worksheet Dim sheetname As String Dim i As Integer Set sheet = ActiveSheet For i = 1 To 41 sheetname = sheet.Cells(i, 1) Sheets(sheetname).Move after:=Sheets(i) Next sheet.Activate End Sub
其中 sheet是新建了一个空白工作表,然后一个41行
-
VBA常用技巧
2014-12-21 16:39:28131-4 在Listview控件中排序 12 131-5 Listview控件的图标设置 12 技巧132 调用非模式窗体 12 技巧133 进度条的制作 12 133-1 使用进度条控件 12 133-2 使用标签控件 12 技巧134 使用TreeView控件显示层次 12 技巧... -
VBA学习笔记2-数据结构类型ArrayList
2019-12-28 18:02:53VBA学习笔记2-数据结构类型ArrayList一、这个东西是干什么的二、创建ArrayList1,前期绑定2,后期绑定三、常用方法和属性1,添加2,判断集合大小3,重点来了排序的办法3.1,升序排序3.2,降序排序4,复制集合的方法5...VBA学习笔记2-数据结构类型ArrayList
一、这个东西是干什么的
在VBA里数组的排序是很让人头痛的事情,一般采用冒泡,选择,快速,插入,希尔等算法来对数组进行排序
- 冒泡,选择,插入排序等因为循环次数太多,效率感人
- 快速排序,因为条件苛刻,要求整数,并且最大和最小相差太大,速度也会很慢
- 希尔排序,算法真心它能看明白我,我看不明白它
有没有一种又简单,又好用的对数组进行排序的
答案是有,知道的就有2个现成的对象,可以调用,今天我们来学习其中一个ArrayList对象二、创建ArrayList
1,前期绑定
单击“工具——引用”,在“引用”对话框中,找到并选中mscorlib.dll
前的复选框Dim arrlist As New arraylist
2,后期绑定
Sub lizi2() Dim arrList As Object Set arrList = CreateObject("System.Collections.ArrayList") Set arrList = Nothing End Sub
三、常用方法和属性
1,添加
- Add方法,arrList.Add item
itme 可以是数字,字符串,对象等变量,但是如果排序数据类型尽量统一,经过测试数字和文本比较会出错,用这方法的时候,都用数字好了
Sub lizi2() Dim arrList As Object Set arrList = CreateObject("System.Collections.ArrayList") arrList.Add 1 arrList.Add 11 arrList.Add 5 arrList.Add 6 arrList.Add 9 Set arrList = Nothing End Sub
- Insert方法在特定位置插入数据
Sub lizi2() Dim arrList As Object, i As Long Set arrList = CreateObject("System.Collections.ArrayList") arrList.Add 1 arrList.Add 11 arrList.Add 5 arrList.Add 6 arrList.Add 9 arrList.Insert 0, 10 For i = 0 To arrList.count - 1 Debug.Print i & ":" & arrList(i) Next Set arrList = Nothing End Sub
显示结果
0:10 1:1 2:11 3:5 4:6 5:9
2,判断集合大小
- ArrayList.Count,来判断,是从0开始到ArrayList.Count-1的,循环的时候注意
For i = 0 To arrList.count - 1 Debug.Print i & ":" & arrList(i) Next
3,重点来了排序的办法
3.1,升序排序
ArrayList.sort
3.2,降序排序
ArrayList.sort
ArrayList.Reverse
先排序,后面接一句这个就可以降序排序Sub lizi2() Dim arrList As Object, i As Long Set arrList = CreateObject("System.Collections.ArrayList") arrList.Add 1 arrList.Add 11 arrList.Add 5 arrList.Add 6 arrList.Add 9 arrList.Insert 0, 10 arrList.Sort For i = 0 To arrList.count - 1 Debug.Print i & ":" & arrList(i) Next Set arrList = Nothing End Sub
显示结果
0:1 1:5 2:6 3:9 4:10 5:11
降序
Sub lizi2() Dim arrList As Object, i As Long Set arrList = CreateObject("System.Collections.ArrayList") arrList.Add 1 arrList.Add 11 arrList.Add 5 arrList.Add 6 arrList.Add 9 arrList.Insert 0, 10 arrList.Sort '先排序,这时候是升序 arrList.Reverse '再来一句相反的,变降序了 For i = 0 To arrList.count - 1 Debug.Print i & ":" & arrList(i) Next Set arrList = Nothing End Sub
显示结果
0:11 1:10 2:9 3:6 4:5 5:1
速度又快,有简单
4,复制集合的方法
- Clone方法
Sub lizi2() Dim arrList As Object, i As Long Dim arrList2 As Object, brr() Set arrList = CreateObject("System.Collections.ArrayList") Set arrList2 = CreateObject("System.Collections.ArrayList") arrList.Add 1: arrList.Add 11: arrList.Add 9 arrList.Add 5: arrList.Add 6: arrList.Insert 0, 10 Set arrList2 = arrList.Clone '把没排序之前的集合复制一个新的 arrList.Sort arrList.Reverse ReDim brr(1 To arrList.count + 1, 1 To 1) For i = 0 To arrList.count - 1 brr(i + 1, 1) = arrList(i) Next Range("a1").Resize(arrList.count + 1, 1).Value = brr ReDim brr(1 To arrList.count + 1, 1 To 1) For i = 0 To arrList2.count - 1 brr(i + 1, 1) = arrList2(i) Next Range("b1").Resize(arrList.count + 1, 1).Value = brr Set arrList = Nothing: Set arrList2 = Nothing End Sub
结果
5,删除办法
- ArrayList.Clear
直接全部干掉了 - ArrayList.Remove item
item必须是添加进去的内容,不支持索引这里
Sub lizi2() Dim arrList As Object, i As Long Dim arrList2 As Object, brr() Set arrList = CreateObject("System.Collections.ArrayList") Set arrList2 = CreateObject("System.Collections.ArrayList") arrList.Add 1: arrList.Add 11: arrList.Add 9 arrList.Add 5: arrList.Add 6: arrList.Insert 0, 10 Set arrList2 = arrList.Clone arrList.Remove 11 '删除item是11的内容 arrList.Sort arrList.Reverse '降序 '下面内容全部是返回单元格 ReDim brr(1 To arrList.count + 1, 1 To 1) For i = 0 To arrList.count - 1 brr(i + 1, 1) = arrList(i) Next Range("a1").Resize(arrList.count + 1, 1).Value = brr ReDim brr(1 To arrList.count + 1, 1 To 1) For i = 0 To arrList2.count - 1 brr(i + 1, 1) = arrList2(i) Next Range("b1").Resize(arrList.count + 1, 1).Value = brr Set arrList = Nothing: Set arrList2 = Nothing End Sub
显示结果
6,可以直接复制成一个数组
- ToArray方法
Sub lizi2() Dim arrList As Object, i As Long Dim arrList2 As Object, brr() Set arrList = CreateObject("System.Collections.ArrayList") arrList.Add 1: arrList.Add 11: arrList.Add 9 arrList.Add 5: arrList.Add 6: arrList.Insert 0, 10 brr = arrList.toarray '从0开始的一维数组 Range("a1").Resize(UBound(brr) + 1, 1).Value = _ Application.WorksheetFunction.Transpose(brr) Set arrList = Nothing End Sub
因为这个,只有单纯的item不能进行更为快速的查找,有没有一个对象,可以再添加进去的过程中就排好序呢?
下次分享更为健全的SortedList对象使用
学习来源:完美Excel微信公众号,感谢大佬的无私分享
-
他山之石——VBA数组的使用-Part2(VBA Array)
2018-06-24 00:18:42'数组是用编号排序的,那么如何获得一个数组的大小呢 'Lbound(数组) 可以获取数组的最小下标(编号) 'Ubound(数组) 可以获取数组的最大上标(编号) 'Ubound(数组,1) 可以获得数组的行方面(第1维)最大上标 'Ubound... -
VBA编程技巧大全
2013-08-05 09:03:19131-4 在Listview控件中排序 322 131-5 Listview控件的图标设置 323 技巧132 调用非模式窗体 326 技巧133 进度条的制作 328 133-1 使用进度条控件 328 133-2 使用标签控件 330 技巧134 使用TreeView控件显示层次 333... -
Excel VBA技巧实例手册
2016-07-28 22:29:39第1篇 ExcelVBA基础 第1章 了解Excel宏 1.1 创建宏 技巧001显示“开发工具”选项卡 技巧002录制第一个宏 技巧003在VBE中创建宏 1.2 管理宏 技巧004运行宏 技巧005编辑宏 技巧006保存宏 技巧007设置宏的安全性 第2... -
python3对字典进行排序_如何对字典的键值进行排序处理
2020-11-21 17:19:24大家好,今日我们继续讲解VBA数组与字典解决方案,今日讲解第59讲内容:利用工作表函数,对字典的键值按大小排序,并给出对应的键.在字典和数组中,是不能如工作表中那样进行直接排序的,需要借助于函数来进行.我在上一... -
中文版Excel.2007高级VBA编程宝典 1/2
2012-04-06 16:00:1611.1.3 复制大小可变的单元格区域 11.1.4 选中或者识别各种类型的单元格区域 11.1.5 提示输入单元格中的值 11.1.6 在下一个空单元格中输入一个值 11.1.7 暂停宏的运行以便获得用户选中的单元格区域 ... -
中文版Excel.2007高级VBA编程宝典 2/2
2012-04-06 16:41:3811.1.3 复制大小可变的单元格区域 11.1.4 选中或者识别各种类型的单元格区域 11.1.5 提示输入单元格中的值 11.1.6 在下一个空单元格中输入一个值 11.1.7 暂停宏的运行以便获得用户选中的单元格区域 ... -
Excel VBA实用技巧大全 附书源码
2010-10-08 18:59:2401012获取Excel窗口的状态(大小) 01013获取Excel主窗口的高度和宽度 01014获取Excel主窗口的左边界位置和顶端位置 01015获取在Excel主窗口中一个窗口所能占有的最大高度和宽度 01016获取当前打印机名称 01017获取... -
VBA /VB/VB中合成分散数据方法
2019-09-24 12:00:25公司用于项目号的合成,怕忘记,特此放上这里。...(数组大小根据表中数据个数判断) 3、排序(这里用冒泡法,小到大) 4、综合判断数据(核心判断:从步距来判断是否连接和使用哪种符号相连,... -
Office百宝箱 v29.0 【Excel、Word、PPT、Outlook、Publisher、VBA编程、办公必备插件】
2019-05-03 16:24:10原创批量图片排序功能,誉为“图片排版大师”,有21种样式可选,能批量将工作表中指定存储格范围的图片快速排序并输出到新表中。原创无穷加密与解密功能,能对选定的存储格或文本内容进行军方级加密保护,使其显示只... -
DS&ML_用Excel实现按行排序后按列排序,最后高亮重复值
2020-10-03 04:43:26记录一个刚刚用本‘笨’办法解决的数据清洗和数据整理问题 前几天收到邮件,对之前我一篇论文的方法进行测试的时候有些疑问。我在复现的时候遇到了以下的问题: ...首先,分别按照编号大小左右排序,再从 -
EXCEL万能百宝箱 V29.8 内置了图片百宝箱、财务百宝箱、函数百宝箱、二维码百宝箱.rar
2020-04-11 21:14:59批量二维码识别、批量二维码生成、表格数据汇总、全自动检索录入、数据采集大师、批量改图片大小、批量图片导入、批量图片导出、批量导图入批注、图片查询、批量图片排序大师、批量图片格式转换、批量文字水印与Logo... -
EXCEL万能百宝箱V30.0珍藏版—480个实用功能,一码三用,批量打印二维码条形码.rar
2020-06-07 12:52:35表格数据汇总、全自动检索录入、数据采集大师、批量改图片大小、批量图片导入、批量图片导出、批量导图入批注、图片查询、截长图与分页截图、批量图片排序大师、批量图片格式转换、批量文字水印与Logo水印、批量取... -
EXCEL万能百宝箱64位 V29.0珍藏版—智慧轻巧办公,批量打印二维码条形码,十倍提效率,一码三用,480个功能...
2020-06-07 13:02:40表格数据汇总、全自动检索录入、数据采集大师、批量改图片大小、批量图片导入、批量图片导出、批量导图入批注、图片查询、截长图与分页截图、批量图片排序大师、批量图片格式转换、批量文字水印与Logo水印、批量取... -
Excel 2007数据透视表完全剖析 5/7
2012-04-01 09:28:32高级(ad-hoc)查询,即时数据分析,计算字段,前10评级,根据季度将数据分组,设置解决方案的格式,常见的故障排除方法,外部和OLAP数据,数据透视图,利用VBA实现自动化,Excel服务器,熟悉功能区。 “使用没有... -
Excel 2007数据透视表完全剖析 4/7
2012-04-01 09:23:38高级(ad-hoc)查询,即时数据分析,计算字段,前10评级,根据季度将数据分组,设置解决方案的格式,常见的故障排除方法,外部和OLAP数据,数据透视图,利用VBA实现自动化,Excel服务器,熟悉功能区。 “使用没有... -
Excel 2007数据透视表完全剖析 3/7
2012-04-01 09:18:53高级(ad-hoc)查询,即时数据分析,计算字段,前10评级,根据季度将数据分组,设置解决方案的格式,常见的故障排除方法,外部和OLAP数据,数据透视图,利用VBA实现自动化,Excel服务器,熟悉功能区。 “使用没有... -
Excel 2007数据透视表完全剖析 1/7
2012-04-01 09:06:34高级(ad-hoc)查询,即时数据分析,计算字段,前10评级,根据季度将数据分组,设置解决方案的格式,常见的故障排除方法,外部和OLAP数据,数据透视图,利用VBA实现自动化,Excel服务器,熟悉功能区。 “使用没有... -
Access2003中文版应用基础教程(高清中文PDF)
2011-05-20 15:24:55本书分为12章,涵盖了使用Access 2003来设计数据库系统的相关概念与技巧,通过实例让读者轻松学会表、查询、窗体、数据访问页的制作,更有宏、控件、VBA等高级应用知识等待你去探索。 本书理论与实践相结合,解说... -
Excel百宝箱9.0无限制破解版
2012-02-03 19:05:29【按颜色排序】:让Excel 2003也可以按背景色排序数据,2007或者2010用户不需要使用 【返回首页】:配合建立工作表目录工具使用,可以在任何工作表中瞬间返回第一个工作表 【工作簿标签】:将当前开启的工作簿创建一... -
Excel百宝箱
2012-10-27 17:09:21【按颜色排序】:让Excel 2003也可以按背景色排序数据,2007或者2010用户不需要使用 【返回首页】:配合建立工作表目录工具使用,可以在任何工作表中瞬间返回第一个工作表 【工作簿标签】:将当前开启的工作簿创建一... -
Access2003中文版应用基础教程part3
2009-04-02 09:21:21本书分为12章,涵盖了使用Access 2003来设计数据库系统的相关概念与技巧,通过实例让读者轻松学会表、查询、窗体、数据访问页的制作,更有宏、控件、VBA等高级应用知识等待你去探索。 本书理论与实践相结合,解说... -
Access2003中文版应用基础教程part1
2009-04-02 09:00:35本书分为12章,涵盖了使用Access 2003来设计数据库系统的相关概念与技巧,通过实例让读者轻松学会表、查询、窗体、数据访问页的制作,更有宏、控件、VBA等高级应用知识等待你去探索。 本书理论与实践相结合,解说... -
Access2003中文版应用基础教程part2
2009-04-02 09:16:00本书分为12章,涵盖了使用Access 2003来设计数据库系统的相关概念与技巧,通过实例让读者轻松学会表、查询、窗体、数据访问页的制作,更有宏、控件、VBA等高级应用知识等待你去探索。 本书理论与实践相结合,解说... -
Access 2000数据库系统设计(PDF)---001
2006-02-23 15:31:04382.5 探索窗体设计视图和VBA类模块 392.6 现实世界—所学知识的透视 40第3章 Access导航 423.1 理解Access功能和模式 423.1.1 定义Access功能 423.1.2 定义Access操作模式 443.2 理解Access的表显示 443.2.1 最大化...