VBA17排序算法(快速/桶/计数)

之之之之杰

于 2022-11-09 12:47:25 发布

阅读量980

点赞数 2

分类专栏： VBA 文章标签：排序算法 microsoft

本文链接：https://blog.csdn.net/q14091355/article/details/127767491

版权

VBA 专栏收录该内容

20 篇文章 10 订阅

订阅专栏

本文详细介绍了四种不同的VBA排序算法：随机数生成、快速排序、桶排序/计数排序以及VBA内置函数SMALL排序。通过实例展示了每种排序方法的实现过程和耗时，其中快速排序和桶排序在速度上有显著优势，但对数据源有一定限制。VBA内置的SMALL函数排序虽然简单易用，但在大数据量时效率较低。

摘要由CSDN通过智能技术生成

数据源准备:

创建0-99的随机序放在[A1:A10000]

Sub Suijixu() '创建0-99的随机序放在[A1:A10000]
    Dim T
    T = Timer                    'Timer 函数返回本机此刻时间
    Dim suiji1 As Integer
    For suiji1 = 1 To 10000
        Cells(suiji1, 1) = Int(Rnd() * 100)    'INT函数求整.RND函数返回随机个位小数
    Next
    'MSGBOX TIMER - T            '显示运行时间
End Sub

四、快速排序

个人理解：快速排序是取出一元素作为基准数，后将此基准数扫描较小的元素放左边排列位置，较大的元素放右边排列位置，从而得到2个区间，再以递归形式从2个区间中继续分区，直至各区间少于2个元素则排序完成。类似于二分法。

创建递归调用程序:

Sub kuais(ByRef arr, l1 As Integer, r1 As Integer)
        'arr为数组,nleft为最小元素，nright为最大元素
        Dim i As Integer, j As Integer, vkey As Integer, str As Integer
        If l1 >= r1 Then Exit Sub    '如果元素个大于总个则退出
        vkey = arr(l1, 1)                 '基准数
        i = l1 + 1                       '基准的下一个数开始对比
        j = r1                         '最右边的数
        Do
            Do While i <= r1
                If arr(i, 1) > vkey Then Exit Do     '定位比基准数小的位置
                i = i + 1
            Loop
            Do While j > l1
                If arr(j, 1) < vkey Then Exit Do     '定位比基准数大的位置
                j = j - 1
            Loop
            If i >= j Then Exit Do          '循环退出条件是扫描值遇到。
            str = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = str         '比基准数小的位置交换
        Loop
        If l1 <> j Then
            str = arr(l1, 1): arr(l1, 1) = arr(j, 1): arr(j, 1) = str     '比基准数大的位置交换
        End If
        If l1 < j Then Call kuais(arr, l1, j)                             
    '分区再调用左，当没有比基准数大的时候才执行下一步，否则一直执行抽出递归再排列
        If j + 1 < r1 Then Call kuais(arr, j + 1, r1)                 
    '分区再调用右，当元素个不少于1个以上时排列右边
        'Stop       '调试
    End Sub

快速排序调用递归：

    Sub 快速排序()
        Dim T
        Dim arr, x As Integer, y As Integer
        T = Timer
        arr = [A1:A10000]
        y = UBound(arr)
        x = LBound(arr)
        Call kuais(arr, x, y)       '设置调用程序
        'Stop
        Range("h2").Resize(UBound(arr), 1) = arr
        Range("H1") = Timer - T
    End Sub

本机测试快速排序耗时为0.04秒,优点是速度上跟希尔差不多,对大部份数据源都适用，需写法较难维护。需调用递归写法

五、桶排序/计数排序

个人理解：桶排序的思想是根据数据源的分布，将其分成N等份创建出对应的N桶，分别把对应的数据装入N桶里。再分别对N里面排序后进行合并。

计数排序是根据数据源创建一个已排序好的范围进计统计,再按统计完的范围*次数还原数据排序。桶排序跟计数较相似，对数据源都有比较高的限制，一般应用于一定整数范围。

（本例子数据源为0-99整数、桶排序先分10*N的桶。先分别用计数排序创建0-9的序列统计后合并)

Sub 桶排序()
        Dim T
        T = Timer
        Dim Trr(1 To 10100, 1 To 10)        '定义二维数组为10*桶
        Dim Trr2(1 To 10)                   '桶位置装入计数
        Dim arr
        Dim x As Integer, y As Integer
        arr = [A1:A10000]                   '数据源装入
        For x = 1 To UBound(arr)
            y = arr(x, 1) \ 10 + 1          '据数据源转为桶位置，+1是数组定义为1to10
            Trr2(y) = Trr2(y) + 1           '装入计数
            Trr(Trr2(y), y) = arr(x, 1)     '分别装入
         Next
         'Stop                              '调试
         Dim jrr(0 To 9, 1 To 10)           '定义二维数组做计数排序
         Dim i As Integer, o As Integer, p As Integer
            o = 1                           '初始化
         For i = 1 To 10
            Do While Trr(o, i) <> ""        '对桶内数据进行统计
                p = Trr(o, i) Mod 10        '根据余数(尾数)统计
                jrr(p, i) = jrr(p, i) + 1
                o = o + 1                   '装入计数
            Loop
            o = 1                           '初始化计数
        Next
        'Stop                               '调试
        Dim crr(1 To 10100, 1 To 1)         '定义一个数组装排序好的数据
        Dim h%, h1%, zhi%, k%
        k = 1
        For h1 = 1 To 10
            For h = 0 To 9
                zhi = jrr(h, h1)
                Do While zhi <> 0           '对计数里面的次数进行循环取出
                    crr(k, 1) = h + (h1 - 1) * 10
                    zhi = zhi - 1
                    k = k + 1
                Loop
            Next
        Next
        'Stop                               '调试
        Range("i2").Resize(UBound(crr), 1) = crr    '输出
        Range("i1") = Timer - T
    End Sub

本机桶/计数排序耗时为0.01秒,优点是速度快,写法相对简洁一条逻辑下来。缺点是对数据源限制较大、一般适用统计一定区间整数(比如年龄、分数、等）

六、VBA自带函数Small排序

调用VBA函数排序：SMALL(数据，最小第几个),LARGE为取最大函数

Sub 自带VBA函数Small排序()
        Dim T
        Dim Drr
        Dim Err(1 To 10000, 1 To 1)
        Dim g%
        T = Timer
        Drr = [A1:A10000]
        For g = 1 To 10000
        Err(g, 1) = Application.WorksheetFunction.Small(Drr, g)
        Next
        'Stop
        Range("J2").Resize(UBound(Err), 1) = Err    '输出
        Range("J1") = Timer - T
End Sub

本例VBA自带函数SMALL排序耗时为11.39秒,优点是写法简单。缺点是速度慢，只适合数据量不多的情况。

VBA排序到此结束，谢谢观看。