精华内容
下载资源
问答
  • Excel 2010 VBA 入门 107 数组排序
    2021-07-15 10:16:47

       

    目录

    ByVal和ByRef的区别

    选择排序


    编写一个含有参数的过程,其参数为一个数组,并且按引用传递参数。然后在该过程内编写一个数组排序的程序,使得数组按照升序排序。

    Option Explicit
    Sub Main()
        Dim arr
        arr = Array(1, 3, 7, -1, 2, 4, 6, 0)
        Debug.Print "原始数组:"; Join(arr, ",")
        sortArray arr
        Debug.Print "排序结果:"; Join(arr, ",")
    End Sub
    
    Sub sortArray(ByRef arr)
        Dim i As Long
        Dim j As Long
        Dim minIndex As Long
        Dim temp As Variant
        For i = LBound(arr) To UBound(arr) - 1
            minIndex = i
            For j = i + 1 To UBound(arr)
                If arr(j) < arr(minIndex) Then minIndex = j
            Next j
            
            If minIndex <> i Then
                temp = arr(minIndex)
                arr(minIndex) = arr(i)
                arr(i) = temp
            End If
        Next i
    End Sub
    

    ByVal和ByRef的区别

        在自定义过程的参数声明中,可以使用两种参数值传递的方法:按值传递(ByVal)和按地址传递(ByRef)。
        若参数为某个基本的数据类型,当参数以ByVal的方式传递时,则在过程中无论对该参数所表示的变量如何赋值,都不会影响原始变量的值。而以ByRef的方式传递时,则在过程中对该参数的任何改变都将影响到该原程序中的变量变化。如运行以下Main过程将会在立即窗口中显示采用ByVal方式传递的参数并未使原var变量增加,而ByRef的参数传递方法则使得var增加了1。

    Option Explicit
    
    Sub main()
        Dim var As Integer
        var = 1
        testByval var
        Debug.Print "按值传递:"; var
        
        testByref var
        Debug.Print "按地址传递:"; var
    End Sub
    
    Sub testByval(ByVal arg As Integer)
        arg = arg + 1
    End Sub
    
    Sub testByref(ByRef arg As Integer)
        arg = arg + 1
    End Sub
    
    

        对于对象变量,无论其采用ByVal还是ByRef方式进行参数传递,在过程中对该参数的任何操作都将影响其变量所表示的对象。如以下Main过程运行后将使当前活动工作表的A1、B1单元
    格赋值为2。
        本例需要对某个数组进行排序,当主程序调用某个过程后需要实现对该主程序中的数组进行排序,显然是通过调用的过程改变了主程序中变量的值。因而采用ByRef参数传递方式,并
    且使用需要进行排序的数组作为参数传递。

    选择排序

        本例对数组排序使用了选择排序的算法,其核心思想是每次从元素中找出最小的那个放在第1个,然后用相同的方法处理剩下的那个。若数组arr中有N个元素,其具体步骤如下:
    (1)将变量m赋值为1。
    (2)假设当前数组第m个元素是最小值,记录下其下标minlndex。
    (3)使用arr (minlndex)与剩下的N-m个元素进行比较。
    (4)若某个元素的值小于arr (minlndex),则将该元素的下标赋值给minindex,继续与下一个进行比较。
    (5)重复步骤(2)、  (3),直到所有的元素比较完毕。
    (6)比较minindex与m元素的下标,若两者不相同,则交换minindex与m所代表的元素的值。
    (7)将m增加1,并重复上述步骤(2)至步骤(6),直到m等于N-1。
        上述各个步骤实际上是每次都在为第m个位置的元素选择一个值,然后填入,该值是m位置之后所有元素的最小值。每次循环都是选择剩下的元素中最小的元素排入队列中,因而称为选择排序。 

    这里有动画演示(膜拜一下):

     https://www.runoob.com/w3cnote/selection-sort.html

    更多相关内容
  • VBA数组排序

    2021-09-13 16:12:32
    我们平时用的表格排序,只相对来说是在在表格中的升序降序。今天就好奇如果系统中实现排序 他是怎么实现的呢。 经过一番折腾查找,真是一看吓一跳,真是感觉蚂蚁看大象,发现排序分为: 今天仅整理了最简单的两种...

    我们平时用的表格排序,只相对来说是在在表格中的升序降序。今天就好奇如果数组中实现排序
    他是怎么实现的呢。

    经过一番折腾查找,真是一看吓一跳,真是感觉蚂蚁看大象,发现排序分为:
    1,稳定排序与不稳定排序2,内排序和外排序内部排序可分为:直接插入排序、冒泡排序、简单选择排序、希尔排序、快速排序、堆排序、归并排序、基数排序。

    晕

    今天仅整理了最简单的两种排序。。。
    先来看下定义和实现的方法吧。

    选择排序(Selection sort)是一种简单直观的排序算法。它的工作原理是:第一次从待排序的数据元素中选出最小(或最大)的一个元素,存放在序列的起始位置,然后再从剩余的未排序元素中寻找到最小(大)元素,然后放到已排序的序列的末尾。以此类推,直到全部待排序的数据元素的个数为零。选择排序是不稳定的排序方法。

    请添加图片描述

    1.简单选择排序

    
    Sub  选择排序()
    Dim i, j, MinIndex As Integer
    Dim MinValue As String
    arr = Range("a1:a10")
     For i = 1 To UBound(arr)
        MinValue = arr(i, 1) '将第一个值先默认为最小值
        MinIndex = i         '记录最小值的索引位置
        For j = MinIndex + 1 To UBound(arr)
            If arr(j, 1) < MinValue Then
                MinValue = arr(j, 1)
                MinIndex = j
            End If
      	Next
        '以此和当前的最小值做对比,比较出后面的最小值并记录 值及索引的位置
        '因为小的值我们都放在最前面,所以遍历只需从当前值的后面开始就可以了,节省时间
        
        If MinIndex > i Then
            arr(MinIndex, 1) = arr(i, 1)
            arr(i, 1) = MinValue
        End If
        '这里的MinIndex和i的关系会有些绕,只会有两个可能,一种是MinIndex > i(在默认最小值的后面有比当前还小的值),另一种MinIndex = i :(在最小值的后面没有找到比当前值的再小的)。
        '【不出现MinIndex < i的情况,只为理解,加不加基本没有影响】
     Next
    [b1].Resize(UBound(arr), 1) = arr
    End Sub
    

    2.冒泡排序

    原理:
    1、比较相邻的元素。如果第一个比第二个大,就交换他们两个。
    2、对每一对相邻元素做同样的工作,从开始第一对到结尾的最后一对。在这一点,最后的元素应该会是最大的数。
    3、针对所有的元素重复以上的步骤,除了最后一个。
    4、持续每次对越来越少的元素重复上面的步骤,直到没有任何一对数字需要比较。
    请添加图片描述

    Sub 冒泡排序()
    arr = Range("a1:a10")
    For j = 1 To UBound(arr)
        For i = 1 To UBound(arr) - 1
              If arr(i, 1) > arr(i + 1, 1) Then
                MinStr = arr(i + 1, 1)
                arr(i + 1, 1) = arr(i, 1)
                arr(i, 1) = MinStr
            End If
        Next
    Next j
    [b1].Resize(UBound(arr), 1) = arr
    End Sub
    
    类别说明
    选择排序缺点:不稳定,具体怎么不问题不知道。。优点:速度要比冒泡排序快很多
    冒泡排序缺点:速度很慢。。优点:稳定

    太多了 ,其他的在这里插入图片描述

    展开全文
  • 目录1,一维数组冒泡排序函数2,二维数组冒泡排序函数 1,一维数组冒泡排序函数 2,二维数组冒泡排序函数

    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_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
    

    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_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
    

    返回结果
    在这里插入图片描述

    参考资料:《冒泡排序》

    展开全文
  • VBA80 26集VBA数组之VBA排序算法(下)
  • VBA示例之 数组按降序排列,供初学者参考,大牛勿进~~~~~~~
  • 冒泡排序算法

           排序,是我们在Excel中最常用的一种功能,一般情况下单元格有sort排序.但是在数组中VBA没有提供类sort方法用于排序.现在为了探究数组内排序的方法,我特意整理的一下VBA数组内排序的笔记分享给大家(如果是高手请无视).有不少地方将数组排序分成七种,十种,十五种,二十五种甚至有五十多种,但无论是几种排序,其实都是以冒泡排序,选择排序,插入排序,希尔排序,归并排序,快速排序,堆排序,桶排序,计数排序,基数排序十种方式为基础的不理解这些基础,后面的排序很难以理解.由于桶排序,基数排序和计数排序是非比较排序,在文本字符串方便处理起来较为复杂,这里不讲.我们只讲除此之外的七种排序,无论数字和文本都能直接调用.

    冒泡排序原理阐述: 冒泡排序的原理是相邻的数据两两对比互换位置,经过多轮两两对比的循环操作就可以实现排序.

    冒泡排序的动作原理演示:

    冒泡排序说明:每一轮都从上至下相邻元素两两对比,如果小值在上大值在下则对调,否则不对调位置(降序),经过多轮对比对调就可完成排序,看图.

    数据: 11 3 9 2 4 5 6 1 10 8 7 7 5 10 13 15 16 14 17 19 18 22 10 20,排序

    我们将冒泡排序分步拆解画图来观察他的原理演示.

    第一步, 3和11对比,3>11,小数在下,不对调位置,看图 

    第二步, 3与9对比,3<9,小数在上,对调位置,换句话说就是小值往下沉.

    第三步:……

            注意观察:上图是第一轮的过程示意图,看图我们发现经过第一轮两两对比最小值1被推到了最下面,这是偶然吗?不妨看看每一轮两两对比的最后一步

    答案在这里:

    因为,每一轮对比过程,我们可以将未排好序的最小值对比出来,而排好序的已经就位,可以不需要再次对比,按照相邻元素两两对比,上面的小值与小面的大值对调位置的原则,最小值永远都会下沉, 

    冒泡排序总结:从上到下两两对比,如果从上到下一轮不够,那就再来几轮,直到完成排序,每次排序几乎都能将一个最大值或者最小值上浮或者下沉到自己的位置上

    演示代码:

    ***********************************************************

    Sub 冒泡排序原理演示()

    Rem 冒泡排序的原理是相邻的两两对比互换位置,经过多轮循环两两对比就可以实现排序

    Rem 难点:理解如何缩短循环过程

        Dim i As Integer,临时存储

    最大行 = 24

        Do

            For i = 2 To 最大行 '构建循环,相邻 单元格进行对比符合条件就互换

        Rem 循环的时候要注意循环起始值需要加1,否则Range("a" & i - 1)会报错

            Union(Range("a" & i), Range("a" & i - 1)).Select

        Rem 组合单元格选定,观察程序执行情况

                If Range("a" & i) > Range("a" & i - 1) Then

        Rem 对比相邻单元格

                    临时存储 = Range("a" & i - 1)

        Rem 设置一个临时储存,记录初始值,因为不能同时替换,所以必须记录初始值, 否则数据会错乱,不理解的朋友可以调试执行试试

                    Range("a" & i - 1) = Range("a" & i)

        Rem 先替换Range("a" & i - 1) = Range("a" & i),此时Range("a" & i - 1)原值被破坏 , 原值备份在临时存储里

                    Range("a" & i) = 临时存储

        Rem Range("a" & i)此时不能等于Range("a" & i - 1),因为原值被破坏,只能从临时存储中取出备份数据,这就是;临时储存存在的意义和设置目的

                End If

            Next i

            最大行 = 最大行 - 1

        Rem 每次执行,都会将最大值(最小值)推到边界上面,所以我们让最大行递减

        Loop While 最大行 > 0

    End Sub

    ***********************************************************

    注:在代码中每一轮两两对比一次我们就将最大行递减一次,for循环就缩短一轮

    数组排序的代码可以根据需求自己修改

    ***********************************************************

    数组排序代码模型:

    Function 数组冒泡排序模型(arr, 起点, 终点)

    Rem 可以更改数组为二维数组 , 每次将其他列数据利用& ","& 符号连接 , 然后将数据放_入第二列,第一列排序替换位置的 时候第二列也替换,输出是利用split函数拆分输出即可

        最大行 = 终点

        Do

            For i = 终点 To 起点 + 1 Step -1

                If arr(i - 1) > arr(i) Then

    Rem 更换"<"或">"符号即可切换升序降序

                    临时储存 = arr(i - 1)

    Rem 临时存储是一个变量,随时更换

                    arr(i - 1) = arr(i)

                    arr(i) = 临时储存

    Rem 数组元素对比后满足条件就值互换位置

                End If

            Next i

        最大行 = 最大行 - 1

        Loop While 最大行 > 0

        数组冒泡排序模型 = arr

    End Function

    ***********************************************************

    我们现在来看看数组模型的测试结果如何

    ***********************************************************

    Sub 冒排测试()

    Dim arr()

    arr = Array(10, 22, 32, 1, 12, 18, 30, 45, 22, 30, 30, 80, 55, 96, 69, 46, 49, 92, 42, 71, 2, 3, 14, 15, 10, 0, 100)

    数组冒泡排序模型 arr, 0, 26

    End Sub

    ***********************************************************

    在end’ sub 设置断点,方便监视窗口查看结果

     

     执行代码,监视窗口查看arr

     

    我们观察到代码执行效果,一维数组已经排好序了

    这里要提醒一点,我们不是专业的程序员,不需要对时间复杂度,空间复杂度和稳定性做过多的研究,但是我们自己要大概知道这是什么东西

    时间复杂度和空间复杂度可以大致理解为:所需的时间和内存对比可以自由选择排序方法

    稳定性:相同元素的相对位置是否变化。

    我们可以观察到冒泡排序是一种稳定的排序,排序方式上面他不需要在自定义一个数组,在数组内部就可以调换,说人话就是使用这种方式不需要在另外再在电脑内存条里专门给他整个位置出来,这种情况一般我们不需要考虑,电脑跑一分钟和一秒钟对于我们而言没区别。我们需要考虑的是稳定性,同样一个元素,调换位置以后对排序结果有没有影响,如果有,我们就需要考虑更换排序方式或者将排序更换为多列排序,增加排序的主次。

    桶排序,基数排序,计数排序由于对字符串的处理很复杂,所以我不做研究。除此三种以外的七种排序方式在VBA中是绝对够用的。

    关于冒泡排序函数的封装:

    首先我们明确代码设计思路:我们已经有了一维数组的排序,那么二维数组多列排序该怎么办?很简单,一维数组排序好以后,记录行号,再利用行号修改数组即可.其次排序不稳定会造成相等元素的相对位置发生变化,比如上面的10会和下面的10发生位置互换,单列还好,但多数情况下我们都是在处理多列数据,相对位置的变化会造成一定的麻烦.为此我特地想到了一个既能记录行号又能避免不稳定的东西---------字典.

    字典两个特性:去重复以及一对一对应.当遇到相同的值我们可以利用dic(key) = item 的特点取出与key 对应的item,然后利用”&”符号连接新的item,如此一来循环录入字典的时候,相同的值会被集中到一起,并且相对位置不会改变,利用行号统一输出的时候恰好就避免了不稳定的问题,同时能记录行号,而字典的keys是一个一维数组,再利用前面的模块,正好就能排序.

    设计代码的时候我考虑为了节约写代码的时间,所以其实将一维数组排序都写成了模块,在多列排序里面我引用了他,七个排序都可以直接使用,这里我推荐郑广学老师(excel880网站站长)的课程,这招跟他学的,好处是提高写代码的效率,同时又避免了代码太长遇到bug长时间无法调试好的风险.但是也有一定难度.初学者不容易实现.

    ***********************************************************

    由于调试复杂这里只说函数如何使用,不另行调试

    这是字典模块,字典模块用于集合相同项避免不稳定,记录行号便于行与行替换

    Private Function 行号记录字典(All, 值列, 数组索引起点, 数组索引终点, Optional 功能 = 0)

    Dim dic '创建字典,采用引用法

        Set dic = CreateObject("Scripting.Dictionary")

    'Dim Dic As New Dictionary '(勾选引用法)

        For i = 数组索引起点 To 数组索引终点

            Key = All(i, 值列)

            If dic.Exists(Key) = False Then

            Rem 不存在key的时候item就等于i,避免下面的 xxx & xxx 录入一个空值

                dic(Key) = i

            Else

                dic(Key) = dic(Key) & "=*=" & i

            End If

        Next

        Rem 根据功能选择输出

        If 功能 = 0 Then

            行号记录字典 = dic.keys '输出字典

        ElseIf 功能 = 1 Then

            行号记录字典 = dic.Items '输出值列

        Else

            Set 行号记录字典 = dic '输出关键字列

        End If

    End Function

    ‘一维数组升序模块

    Private Function 一维数组冒泡升序(arr, 起点, 终点)

    Rem 可以更改数组为二维数组 , 每次将其他列数据利用& ","& _

        符号连接 , 然后将数据放入第二列,第一列排序替换位置的 _

        时候第二列也替换,输出是利用split函数拆分输出即可

        最大行 = 终点

        Do

            For i = 终点 To 起点 + 1 Step -1

                If arr(i - 1) > arr(i) Then

    Rem 更换"<"或">"符号即可切换升序降序

                    临时储存 = arr(i - 1)

    Rem 临时存储是一个变量,随时更换

                    arr(i - 1) = arr(i)

                    arr(i) = 临时储存

    Rem 数组元素对比后满足条件就值互换位置

                End If

            Next i

        最大行 = 最大行 - 1

        Loop While 最大行 > 0

        一维数组冒泡升序 = arr

    End Function

    ‘一维数组降序模块

    Private Function 一维数组冒泡降序(arr, 起点, 终点)

    Rem 可以更改数组为二维数组 , 每次将其他列数据利用& ","& _

        符号连接 , 然后将数据放入第二列,第一列排序替换位置的 _

        时候第二列也替换,输出是利用split函数拆分输出即可

        最大行 = 终点

        Do

            For i = 终点 To 起点 + 1 Step -1

                If arr(i - 1) < arr(i) Then

    Rem 更换"<"或">"符号即可切换升序降序

                    临时储存 = arr(i - 1)

    Rem 临时存储是一个变量,随时更换

                    arr(i - 1) = arr(i)

                    arr(i) = 临时储存

    Rem 数组元素对比后满足条件就值互换位置

                End If

            Next i

        最大行 = 最大行 - 1

        Loop While 最大行 > 0

        一维数组冒泡降序 = arr

    End Function

    '这是多列排序的另外两个模块,此模块是单列排序模块

    Private Function 单列冒泡排序模块(arr, 值列, 起点, 终点)

    Dim 升降 As Boolean

    Rem 判断升序降序,修整数据

    If 值列 < 0 Then

        值列 = Abs(值列)

        升降 = False

    ElseIf 值列 > 0 Then

        值列 = Abs(值列)

        升降 = True

    End If

    ReDim arr_son(起点 To 终点, LBound(arr, 2) To UBound(arr, 2))

    Set Dic = 行号记录字典(arr, 值列, 起点, 终点, 3)

        arr_rows = Dic.Keys '取出关键字排序

        If 升降 = True Then

            arr_rows = 一维数组冒泡升序(arr_rows, LBound(arr_rows), UBound(arr_rows))

        Else

            arr_rows = 一维数组冒泡降序(arr_rows, LBound(arr_rows), UBound(arr_rows))

        End If

    Rem 最后将其输出出来,覆盖掉原来数组中的排序的局部区域

    ReDim brr(LBound(arr_rows) To UBound(arr_rows))

        For i = LBound(arr_rows) To UBound(arr_rows)

            brr(i) = Dic(arr_rows(i)) '首先按排好序的key,取出排好序的item

        Next

        g = 起点 '将排好序的数据导入arr_son数组,做好覆盖前的准备

        For i = LBound(brr) To UBound(brr)

            crr = Split(brr(i), "=*=")

            For t = LBound(crr) To UBound(crr)

                For h = LBound(arr, 2) To UBound(arr, 2)

                    arr_son(g, h) = arr(Abs(crr(t)), h)

                Next

                g = g + 1

            Next

        Next

        For i = 起点 To 终点 '另外构建一个数组,填入部分需要修改的数据,最后覆盖

            For t = LBound(arr, 2) To UBound(arr, 2)

                arr(i, t) = arr_son(i, t)

            Next

        Next

        'Sheet6.Range("j1").Resize(52, 7) = arr '输出检验点

    End Function

    ‘此模块为递归多次引用单列模块的模块,我采用了在递归中递推的办法

    Private Function 多列冒泡排序模块(arr, 值列串, 起点, 终点, Optional 递推 = 0)

        arr_值组 = Split(值列串, ",")

        s = UBound(arr_值组)

        If 递推 > s Then Exit Function

        If 递推 > 5 Then Exit Function

        单列冒泡排序模块 arr, Val(arr_值组(递推)), 起点, 终点

        brr = 行号记录字典(arr, Abs(arr_值组(递推)), 起点, 终点, 1)

        For t = LBound(brr) To UBound(brr)

            crr = Split(brr(t), "=*=")

            If UBound(crr) > 0 Then

                多列冒泡排序模块 arr, 值列串, crr(LBound(crr)), crr(UBound(crr)), 递推 + 1

            End If

        Next

    End Function

     ‘用法如下

    函数:多列冒泡修整数组(数组arr  ,  “+4,-5,+6,-7” , 起始行 , 终止行)

    参数说明:

    (1)数组arr:需要排序的数组

    (2):排序主次列,引号内主列-次列-次次列,为避免代码出现栈溢出,我做了限制,最多支持8行数据的排序

    (3)起始行与终止行:数组需要排序部分的起始行和终止行,如第三行开始到52行这个区域需要排序,起始行就是3,终止行就是52

    备注:本函数支持数组局部排序.此功能常用于表头部分不参与排序的情况

    事例以及上述代码的测试

    1. Sub 多列冒泡测试()
    2. arr = Sheet6.Range("a1:g52")
    3. 多列冒泡排序模块 arr, "+4,-5,+6,-7", 3, 52
    4. Sheet6.Range("j1").Resize(52, 7) = arr '输出检验点
    5. End Sub

    ***********************************************************

    具体排序测试数据,我会提供专门的EXCEL表下期我们会讲解其他的排序

    最后附上数据,与排序结果

    实验数据:

     

    排序结果:

    展开全文
  • 选择排序
  • 快速排序是最常见的排序之一,其排序方式容易理解,排序代码也容易实现,排序速度快,很受欢迎. 首先在了解快速排序之前我们先了解一下冒泡排序,冒泡排序是相邻元素之间两两对比,按小数前大数后的规律调整两数的位置,...
  • VBA实现归并排序
  • VBA实现插入排序
  • 大家好,今日我们继续讲解数组与字典解决方案,今日讲解第47讲:利用字典和数组,实现按指定规则的排序。随着字典讲解的深入,我们发现字典真的很神奇,在VBA代码中,给人以十分清爽的感觉,在这套数组与字典解决方案中,...
  • 排序 vba版本
  • VBA 二维数组冒泡排序实例

    千次阅读 2020-10-06 17:00:39
    学习VBA的同学经常会用到数组排序,网上介绍的程序算法一般都是举例一维数组, 而一般实际使用时更多的需要对二维数组进行排序,本人结合大家分享的冒泡排序算法 编写了二维数组的冒泡排序实例,供大家参考。...
  • VBA中实现数组排序的多种方法

    万次阅读 2015-08-25 09:40:59
    VBA里面没有现成的Sort方法可以使用,VBA里面要对数组进行排序,...除了上述方法以外,借助一些其他语言工具与VBA相结合,也能利用现成的排序功能来实现数组排序,而不需要借助表格。 例如JavaScript:JavaScript里
  • VBA 如何给数组去重?

    千次阅读 2019-12-25 16:56:48
    代码1:字典方法 Sub jackma1() arr1 = Array(1, 2, 3, 4, 5, 1, 1, 1, 5) ...Dim dict1 As Object Set dict1 = CreateObject("scripting.dictionary") ...'把array的element当做key,赋值item为空 ...
  • 数组的存在价值就是让代码提速。...在完成相同工作时,使用数组比非数组的效率有可能提升几倍乃至几十倍,数组对于VBA而言举足轻重。 1、数组的定义: 数组就是连续可索引的具有相同内在数据类型的元素的...
  • VBA 数组定义,赋值,一维数组

    万次阅读 2019-12-19 13:35:43
    1VBA数组的基础定义 1.1什么是数组? 就是一组数/字符等用同一个名字(这个名字就是:数组名),作为一个整体存储在一起 1.2什么是元素 这些被保存在同一个数组名下的,多个内容,称为element 元素 数组里的元素是...
  • vba二维数组排序及转为一维数组

    千次阅读 2020-09-03 23:02:34
    = "'" & sht.Cells(i + 2, 1) & "'" arr(i, 2) = Round(sht.Cells(i + 2, "R") * 100, 2) Next '排序 For i = 1 To 8 For j = i + 1 To 8 If arr(i, 2) (j, 2) Then temp1 = arr(j, 1): temp2 = arr(j, 2) arr(j, 1)...
  • Excel VBA中如何对数组进行去重

    千次阅读 2020-12-24 00:10:50
    在使用Excel VBA的过程中,经常需要使用数组(Array)将数据进行存放,但防止数据出现重复成文了一个问题。这是就可以用到对数组进行去重。现在我们有一个数组分别是a 这个数组中有部分重复数值,我们希望保留不相同的...
  • 2.1 用数组循环的方法,去数组重复也可以 双循环 关键点1:双循环的目的是,循环拿1个数组,和另外一个循环的所有数做对比 关键点2:在外层赋值 关键点3:赋值的计数变量得独立,因为不知道有几个非重复...
  • VBA中的数组排序

    2011-10-19 23:12:00
    在Excel中没有提供直接的方法或函数用于数组排序,因此若要使用VBA进行数组排序,则需要采用我们在数据结构与算法课程中学到的排序算法。 这里转载了Using a Visual Basic Macro to Sort Arrays in Microsoft ...
  • 希尔排序 VBA实现
  • 数组排序——VBA工作簿排序

    千次阅读 2018-10-19 16:54:43
    Sub OrderBy() Dim SheetCount As Long SheetCount = ThisWorkbook.Worksheets.Count - 1 ReDim SheetNameArray(SheetCount) Dim Index As Long Dim Names As String For Index = 0 To She...
  • VBA自定义排序

    2019-10-22 09:03:18
    EXCEL自定义排序最多只能有255个值,超过了就不能用自定义序列了,使用以下方法 求助excelhome论坛得出的答案 Sub 自定义排序() Application.ScreenUpdating = False '排序标准 Dim d As Object Set d = ...
  • Excel VBA数据排序

    2020-12-15 01:01:54
    关注微信公众号:VBA168 每天更新Excel VBA经典代码,祝你工作和学习更轻松! 在如图1所示数据列表中,需要按总成绩从高到低进行排序,示例代码如下。 Sub SortDemo() Range("A1").Sort key1:="总成绩", order1:=...
  • VBA排序的十种算法

    2014-08-08 15:22:40
    vba 排序排序 算法,和好用的。可以直接用的。
  • 只是定义了数组,但由于把数组赋值时放到了if语句里,导致可能由于没有符合if语句的情况而没有给数组具体赋值,然后对数组进行其他操作(比如进行数组内数值排序)就会报错。 我想问下,怎么判断通过dim arr()...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 1,271
精华内容 508
关键字:

vba数组排序

友情链接: wav-file-playback.rar