VBA16排序算法(冒泡/选择/插入/希尔)

之之之之杰

于 2022-10-26 21:05:11 发布

阅读量986

点赞数 2

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

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

版权

VBA 专栏收录该内容

20 篇文章 10 订阅

订阅专栏

数据源准备:

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

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

一、冒泡排序

个人理解：通过数组中的两个数对比，较小(或较大)不断交接位置，完成遍历循环后完成从小(或较大)的排序。

Sub 冒泡排序1()
    Dim t
    Dim x1 As Integer, y1 As Integer, str1 As Integer, d1 As Integer
    Dim arr
    t = timer
    arr = [A1:A10000]
    For x1 = 1 To UBound(arr, 1) - 1
        For y1 = x1 + 1 To UBound(arr, 1)
            If arr(x1, 1) > arr(y1, 1) Then     '如果大于则交换位置,升小到大排。即升序
             str1 = arr(y1, 1)                  '用于中转C = B
            arr(y1, 1) = arr(x1, 1)             'B = A
            arr(x1, 1) = str1                   'A = C
            End If
        Next
    Next
    Range("b2").Resize(UBound(arr, 1), 1) = arr
    Range("b1") = timer - t
End Sub

写法2：冒泡升序完成遍历循环后第1轮，故可以通过相邻的两个数对比来每次筛出一个最大的数在最后的思路来的写FOR的另一种写法.

Sub 冒泡排序2()
  
    Dim t1
    Dim x As Integer, y As Integer, str As Integer, d As Integer
    Dim arr1
    t1 = timer
    arr1 = [A1:A10000]
    For y = UBound(arr1, 1) - 1 To 1 Step -1
        'y = 元素个数减1循环
        For x = 1 To y
            '每循环一次最后得出一个最大数故to y
            If arr1(x, 1) > arr1(x + 1, 1) Then   '如果大于则交换位置,升小到大排。即升序
             str = arr1(x + 1, 1)                '用于中转C = B
            arr1(x + 1, 1) = arr1(x, 1)           'B = A
            arr1(x, 1) = str                  'A = C
            c = c + 1                           '记录交换的次数
            End If
        Next
    Next
    Range("c2").Resize(UBound(arr1, 1), 1) = arr1
    Range("c1") = timer - t1
End Sub

二、选择排序

个人理解：从数组中定位最大的数后放置最后一位位置，不断循环直至完成

Sub 选择排序1().
    Dim t2
    Dim x2 As Integer, y2 As Integer, str2 As Integer, max2 As Integer
    Dim arr2
    t2 = timer
    arr2 = [A1:A10000]
    For x2 = UBound(arr2) To 1 Step -1
        '从最后一位开始,每循环一次确立一个数
        max2 = 1    '初始定位数
        For y2 = 1 To x2
            If arr2(y2, 1) > arr2(max2, 1) Then     '如果在循环数大于定位数。
                max2 = y2                           '则更大的数成为定位数.这里的数代表的是位置定位
            End If
        Next
    str2 = arr2(max2, 1)                            '用于中转C = B
    arr2(max2, 1) = arr2(x2, 1)                     'B = A
    arr2(x2, 1) = str2                              'A = C
    Next x2
    Range("d2").Resize(UBound(arr2, 1), 1) = arr2
    Range("d1") = timer - t2
End Sub

选择排序优化版：基本思路不变，从数组的中同时定位最小跟最大的数放置最前跟最后位置，这样就比正常选择排序少了循环量,但也会多了判断量.

Sub 选择排序2()
    Dim t3
    Dim x3 As Integer, y3 As Integer, str3 As Integer, max3 As Integer, min3 As Integer, strm3 As Integer, z3 As Integer
    Dim arr3
    t3 = timer
    arr3 = [A1:A10000]
        z3 = 1
    For x3 = UBound(arr3) To z3 Step -1
        '从最后一位开始,每循环一次确立一个数
        If z3 > UBound(arr3) \ 2 Then Exit For      '如果大于中位数则退出循环
        max3 = z3       '初始定位数
        min3 = z3       '初始定位数
        For y3 = z3 To x3
            If arr3(y3, 1) > arr3(max3, 1) Then     '如果在循环数大于定位数。
                max3 = y3                           '则更大的数成为定位数.
            End If
            If arr3(y3, 1) < arr3(min3, 1) Then     '如果在循环数小于定位数。
                min3 = y3                           '则更小的数成为定位数.
            End If
        Next
    str3 = arr3(max3, 1)                            '用于装最大数中转C = B
    arr3(max3, 1) = arr3(x3, 1)                     'B = A
    arr3(x3, 1) = str3                              'A = C
    strm3 = arr3(min3, 1)                           '由于装最小数中转
    arr3(min3, 1) = arr3(z3, 1)
    arr3(z3, 1) = strm3
        z3 = z3 + 1                                 '每次进1位
    Next
    Range("e2").Resize(UBound(arr3, 1), 1) = arr3
    Range("e1") = timer - t3
End Sub

三、插入/希尔排序

思路是从第二个开始往前遍历所有值，把当前值选拎出来后对往前比较较小的值不断交换，直至最前都比当前值大的话再插入排到的位置中。

Sub 插入排序()
    Dim T4
    Dim x4 As Integer, y4 As Integer, str4 As Integer
    Dim arr4
    T4 = timer
    arr4 = [A1:A10000]
    For x4 = 2 To UBound(arr4, 1)       '从2 to 50
        str4 = arr4(x4, 1)              '定义空值为第2个开始的值
        For y4 = x4 - 1 To 1 Step -1            '从2往向开始比较
            If arr4(y4, 1) <= str4 Then         '如果比较的值小于则退出第一个FOR
                Exit For
                Else
                arr4(y4 + 1, 1) = arr4(y4, 1)       '如果不小于则将位置交换
            End If
        Next
        arr4(y4 + 1, 1) = str4          '将记录的值插入位置
    Next
    Range("f2").Resize(UBound(arr4, 1), 1) = arr4
    Range("F1") = timer - T4
End Sub

希尔排序是插入排序改良，先算出一个间隔数，这个间隔数从大到小将数组分数分别进行插入排序,直至这个间隔数为1。优点是遇到数据量较大的情况提前分组先排，避免一开始的乱序从头到尾的进行遍历交换位置。从而提高速度。

Sub 希尔排序()
    Dim T5
    Dim x5 As Integer, y5 As Integer, str5 As Integer, Jg As Integer
    '多定义一个Jg为间隔数
    Dim arr5
    T5 = timer
    arr5 = [A1:A10000]
    Jg = UBound(arr5, 1) \ 10            '算出间隔数
    Do While Jg                         '当间隔为0则退出
    For x5 = LBound(arr5, 1) + Jg To UBound(arr5, 1)      '从最小元素+间隔 TO 最大元素
        str5 = arr5(x5, 1)              '先拎出来比较后待插入的值
        For y5 = x5 - Jg To LBound(arr5, 1) Step -Jg           '步行间隔值
            If arr5(y5, 1) <= str5 Then         '如果比较的值小于则退出第一个FOR
                Exit For
                Else
                arr5(y5 + Jg, 1) = arr5(y5, 1)       '如果不小于则将位置交换
            End If
        Next
        arr5(y5 + Jg, 1) = str5          '将记录的值插入位置
    Next
        Jg = Jg \ 3
    Loop
    Range("G2").Resize(UBound(arr5, 1), 1) = arr5
    Range("G1") = timer - T5
End Sub

分组间隔数是多少这个目前在网上各有见解：根据原本希尔排序一开始的说法是一直二分法分割至直变1间隔。但已证实这个并不会提高多少效率。目前流行方法是总元素整除10后再整除3。本次复习使用的就是这样一个公式。一般也有说总元素\3+1。然后间隔=间隔*3+1做一个OD循环来做,本人数学不好,目前接触到的数据量也用不到对这方面有多精确的要求提高。这里就不做讨论。有兴趣的自行实验。.