精华内容
下载资源
问答
  • 排序(使用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=2
    dad+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
    
    展开全文
  • 1、数组的大小数组是用编号排序的,那么如何获得一个数组的大小呢?——表示数组大小的函数:Lbound(数组) 可以获取数组的最小下标(编号)Ubound(数组) 可以获取数组的最大上标(编号)Ubound(数组,1) 可以获得数组的行...

    f4c29738287ab1186d435b1181c6a383.png

    学习资源:《Excel VBA从入门到进阶》第22集 by兰色幻想

    这集视频学习的是数组的空间。

    1、数组的大小

    数组是用编号排序的,那么如何获得一个数组的大小呢?

    ——表示数组大小的函数:

    • Lbound(数组) 可以获取数组的最小下标(编号)
    • Ubound(数组) 可以获取数组的最大上标(编号)
    • Ubound(数组,1) 可以获得数组的行方面(第1维)最大上标
    • Ubound(数组,2) 可以获得数组的列方向(第2维)的最大上标

    2、动态数组的动态扩充

    如果一个数组无法或不方便计算出总的大小,而在一些特殊情况下又不允许有空位。这时我们就需要用动态的导入方法。

    ReDim Preserve arr() 可以声明一个动态大小的数组,而且可以保留原来的数值,就相当于厂房小了,可以改扩建增大,但是它只能让最未维实现动态。如果是一维不存在最未维,只有一维;如果是二维数组的话就只能重新声明第二维。

    注意和ReDim arr()区分,如果在这里误用了ReDim arr(),会清空原数组内容。

    例1:获取大于30数字的数据作为下拉菜单的数据源。

    972165eacc3eeacd9eed976b9ff5f4ba.png
    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

    5d4187e4f3a61242f91a39638f78385e.png
    结果展示1

    5ad8e35b542696d2e9b02012ec92f4ba.png
    结果展示2:数据源发生变化

    例2:读取下表中产品B的数据放入B10单元格。

    d522506dbb7d550263fc9e4b8d85e8a7.png
    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

    结果展示:

    d33a2d45fc9d7256870e7c8670f4c791.png

    如果觉得二维数组逐次声明大小很麻烦,可以先把数组定义得足够大:

    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列样式。

    d5ddc6eae6c3ca2bf410724cb5715b78.png

    思路分析:

    1. 把A列连续数据依次放入数组arr1。
    2. arr读入arr1不为空的数据,遇到数据为空,停止读入arr1;把arr依次写入D列单元格,写入完毕后清空arr内容,并跳到下一列。
    3. 继续写入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
    展开全文
  • 在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:28
    131-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:53
    VBA学习笔记2-数据结构类型ArrayList一、这个东西是干什么的二、创建ArrayList1,前期绑定2,后期绑定三、常用方法和属性1,添加2,判断集合大小3,重点来了排序的办法3.1,升序排序3.2,降序排序4,复制集合的方法5...

    一、这个东西是干什么的

    在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微信公众号,感谢大佬的无私分享

    展开全文
  • '数组是用编号排序的,那么如何获得一个数组的大小呢 'Lbound(数组) 可以获取数组的最小下标(编号) 'Ubound(数组) 可以获取数组的最大上标(编号) 'Ubound(数组,1) 可以获得数组的行方面(第1维)最大上标 'Ubound...
  • VBA编程技巧大全

    2013-08-05 09:03:19
    131-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...
  • 大家好,今日我们继续讲解VBA数组与字典解决方案,今日讲解第59讲内容:利用工作表函数,对字典的键值按大小排序,并给出对应的键.在字典和数组中,是不能如工作表中那样进行直接排序的,需要借助于函数来进行.我在上一...
  • 中文版Excel.2007高级VBA编程宝典 1/2

    热门讨论 2012-04-06 16:00:16
     11.1.3 复制大小可变的单元格区域  11.1.4 选中或者识别各种类型的单元格区域  11.1.5 提示输入单元格中的值  11.1.6 在下一个空单元格中输入一个值  11.1.7 暂停宏的运行以便获得用户选中的单元格区域  ...
  • 中文版Excel.2007高级VBA编程宝典 2/2

    热门讨论 2012-04-06 16:41:38
     11.1.3 复制大小可变的单元格区域  11.1.4 选中或者识别各种类型的单元格区域  11.1.5 提示输入单元格中的值  11.1.6 在下一个空单元格中输入一个值  11.1.7 暂停宏的运行以便获得用户选中的单元格区域  ...
  • 01012获取Excel窗口的状态(大小) 01013获取Excel主窗口的高度和宽度 01014获取Excel主窗口的左边界位置和顶端位置 01015获取在Excel主窗口中一个窗口所能占有的最大高度和宽度 01016获取当前打印机名称 01017获取...
  • 公司用于项目号的合成,怕忘记,特此放上这里。...(数组大小根据表中数据个数判断) 3、排序(这里用冒泡法,小到大) 4、综合判断数据(核心判断:从步距来判断是否连接和使用哪种符号相连,...
  • 原创批量图片排序功能,誉为“图片排版大师”,有21种样式可选,能批量将工作表中指定存储格范围的图片快速排序并输出到新表中。原创无穷加密与解密功能,能对选定的存储格或文本内容进行军方级加密保护,使其显示只...
  • 记录一个刚刚用本‘笨’办法解决的数据清洗和数据整理问题 前几天收到邮件,对之前我一篇论文的方法进行测试的时候有些疑问。我在复现的时候遇到了以下的问题: ...首先,分别按照编号大小左右排序,再从
  • 批量二维码识别、批量二维码生成、表格数据汇总、全自动检索录入、数据采集大师、批量改图片大小、批量图片导入、批量图片导出、批量导图入批注、图片查询、批量图片排序大师、批量图片格式转换、批量文字水印与Logo...
  • 表格数据汇总、全自动检索录入、数据采集大师、批量改图片大小、批量图片导入、批量图片导出、批量导图入批注、图片查询、截长图与分页截图、批量图片排序大师、批量图片格式转换、批量文字水印与Logo水印、批量取...
  • 表格数据汇总、全自动检索录入、数据采集大师、批量改图片大小、批量图片导入、批量图片导出、批量导图入批注、图片查询、截长图与分页截图、批量图片排序大师、批量图片格式转换、批量文字水印与Logo水印、批量取...
  • 高级(ad-hoc)查询,即时数据分析,计算字段,前10评级,根据季度将数据分组,设置解决方案的格式,常见的故障排除方法,外部和OLAP数据,数据透视图,利用VBA实现自动化,Excel服务器,熟悉功能区。  “使用没有...
  • 高级(ad-hoc)查询,即时数据分析,计算字段,前10评级,根据季度将数据分组,设置解决方案的格式,常见的故障排除方法,外部和OLAP数据,数据透视图,利用VBA实现自动化,Excel服务器,熟悉功能区。  “使用没有...
  • 高级(ad-hoc)查询,即时数据分析,计算字段,前10评级,根据季度将数据分组,设置解决方案的格式,常见的故障排除方法,外部和OLAP数据,数据透视图,利用VBA实现自动化,Excel服务器,熟悉功能区。  “使用没有...
  • 高级(ad-hoc)查询,即时数据分析,计算字段,前10评级,根据季度将数据分组,设置解决方案的格式,常见的故障排除方法,外部和OLAP数据,数据透视图,利用VBA实现自动化,Excel服务器,熟悉功能区。  “使用没有...
  • 本书分为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用户不需要使用 【返回首页】:配合建立工作表目录工具使用,可以在任何工作表中瞬间返回第一个工作表 【工作簿标签】:将当前开启的工作簿创建一...
  • 本书分为12章,涵盖了使用Access 2003来设计数据库系统的相关概念与技巧,通过实例让读者轻松学会表、查询、窗体、数据访问页的制作,更有宏、控件、VBA等高级应用知识等待你去探索。 本书理论与实践相结合,解说...
  • 本书分为12章,涵盖了使用Access 2003来设计数据库系统的相关概念与技巧,通过实例让读者轻松学会表、查询、窗体、数据访问页的制作,更有宏、控件、VBA等高级应用知识等待你去探索。 本书理论与实践相结合,解说...
  • 本书分为12章,涵盖了使用Access 2003来设计数据库系统的相关概念与技巧,通过实例让读者轻松学会表、查询、窗体、数据访问页的制作,更有宏、控件、VBA等高级应用知识等待你去探索。 本书理论与实践相结合,解说...
  • 382.5 探索窗体设计视图和VBA类模块 392.6 现实世界—所学知识的透视 40第3章 Access导航 423.1 理解Access功能和模式 423.1.1 定义Access功能 423.1.2 定义Access操作模式 443.2 理解Access的表显示 443.2.1 最大化...

空空如也

空空如也

1 2 3 4 5 6
收藏数 109
精华内容 43
关键字:

vba大小排序