zoukankan      html  css  js  c++  java
  • VBA排序之(冒泡排序、选择排序、插入排序、快速排序、希尔排序)

    主程序:

    Sub mymain()
        Dim MainArr, t
        Application.ScreenUpdating = False
        t = timer
        With ThisWorkbook.Worksheets("排序")
            MainArr = .Range("a2: a" & Cells(Rows.Count, "a").End(xlUp).Row)
            InsertionSort arr:=MainArr
            .Range("c2").Resize(UBound(MainArr), 1) = MainArr
        End With
        MsgBox Format(timer - t, "0.00s")
        Application.ScreenUpdating = True
    End Sub'

    1、冒泡排序运作方式:
    1.1、比较相邻的两个元素,按所需顺序决定是否交换。
    1.2、对每一对相邻元素进行同样的工作,从第一对至最后一对。结束后,最后一个元素应该是所需顺序的最值(如所需顺序为由小至大,则为最大值)。
    1.3、对所有元素重复上述步骤,除了最后一个。
    1.4、重复前述步骤,称前部分需要对比的为无序区,后部分不需要对比的为有序区,直到无序区仅剩一个元素。

    Sub BubbleSort(ByRef arr)
        Dim i&, j&, vSwap
        For i = UBound(arr) To 2 Step -1
            For j = 1 To i - 1
                If arr(j, 1) > arr(j + 1, 1) Then
                    vSwap = arr(j, 1)
                    arr(j, 1) = arr(j + 1, 1)
                    arr(j + 1, 1) = vSwap
                End If
            Next
        Next
    End Sub

    2、选择排序运作方式:
    2.1、对(无序区)全部元素由前至后扫描,找出最值。
    2.2、将最值元素与(无序区)第一个元素交换,此时前端为有序区,后端为无序区。
    2.3、重复上述步骤,直到无序区仅剩一个元素。

    Sub SelectionSort(ByRef arr)
        Dim i&, j&, vSwap, min&
        For i = 1 To UBound(arr)
            min = i
            For j = i + 1 To UBound(arr)
                If arr(min, 1) > arr(j, 1) Then min = j
            Next
            If min <> i Then
                vSwap = arr(min, 1)
                arr(min, 1) = arr(i, 1)
                arr(i, 1) = vSwap
            End If
        Next
    End Sub

    3、插入排序运作方式:
    3.1、全部元素同样的分为有序区在前和无序区在后,开始时有序区仅有第一个元素。
    3.2、取无序区的第一个元素,与有序区中元素由后至前扫描对比。
    3.3、将该元素插入至正确位置,该位置(含)之后的有序区元素向后移位,将该位置赋值为该元素。
    3.4、重复上述步骤,直至无序区仅剩一个元素

    Sub InsertionSort(ByRef arr)
        Dim i&, j&, vTemp
        For i = 2 To UBound(arr)
            vTemp = arr(i, 1)
            For j = i To 2 Step -1
                If arr(j - 1, 1) < vTemp Then Exit For
                arr(j, 1) = arr(j - 1, 1)
            Next
            arr(j, 1) = vTemp
        Next
    End Sub

    4、快速排序运作方式:
    快速排序与二叉查找树基于一样的思路,采用了分治(Divide & Conquer)的策略。
    4.1、选择一个元素作为比较的基准(Pivot)。
    4.2、将所有元素与基准逐个对比,按所需顺序置于基准的两侧,如升序排列时大的放在基准右侧、小的放在左侧,将整个数据划分为左右两个分区。
    4.3、视左右两个分区为两个单独的待排序数据,递归的重复上述操作,直至分区中元素只有一个。
    取分区第一个元素作为基准的VBA实现,调用时 nLeft=LBound(arr): nRight=UBound(arr)

    Sub QuickSort(ByRef arr, ByRef nLeft&, ByRef nRight&)
        Dim i&, j&, vKey, vSwap
        If nLeft >= nRight Then Exit Sub
        vKey = arr(nLeft, 1)
        i = nLeft + 1
        j = nRight
        Do
            Do While i <= nRight
                If arr(i, 1) > vKey Then Exit Do
                i = i + 1
            Loop
            Do While j > nLeft
                If arr(j, 1) < vKey Then Exit Do
                j = j - 1
            Loop
            If i >= j Then Exit Do
            vSwap = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = vSwap
        Loop
        If nLeft <> j Then
            vSwap = arr(nLeft, 1): arr(nLeft, 1) = arr(j, 1): arr(j, 1) = vSwap
        End If
        If nLeft < j Then Call QuickSort(arr, nLeft, j)
        If j + 1 < nRight Then Call QuickSort(arr, j + 1, nRight)
    End Sub

    5、希尔排序运作方式:
    希尔排序是插入排序的一个优化。在插入排序中,每次对比是由后前逐个对比,或言对比的步长为1。
    对比的步长可由大至小,直至步长为1变为插入排序。这样一来在最初的几个对比步长中,较小的元素(假设按升序排序)就会向目标位置前进一大步。
    5.1、设置步长序列,由大至小。
    5.2、由步长序列中,逐个获取步长。
    5.3、由源数据中第步长+1个元素向后扫描,作为基准值。
    5.4、由步骤3中的基准值元素向前扫描与基准值对比,并进行必要的位移,同时每次递减为步长而不是1。
    5.5 、将基准值插入到正确的位置?
    5.6、重复2、3、4、5,直至步长为1。

    Sub ShellSort(ByRef arr)
        Dim i&, j&, vTemp, aGaps, nGap, nLen&
        aGaps = Array(701, 301, 132, 57, 23, 10, 4, 1)
        nLen = UBound(arr)
        For Each nGap In aGaps
            For i = nGap + 1 To nLen
                vTemp = arr(i, 1)
                For j = i To nGap + 1 Step nGap * -1
                    If arr(j - nGap, 1) < vTemp Then Exit For
                    arr(j, 1) = arr(j - nGap, 1)
                Next
                arr(j, 1) = vTemp
            Next
        Next
    End Sub

     

     

  • 相关阅读:
    YearsBetween、MonthsBetween ... YearSpan、MonthSpan ... 间隔时间
    SysUtilsFunction
    DateOf、TimeOf、YearOf、MonthOf、WeekOf、DayOf、HourOf、MinuteOf、SecondOf、MilliSecondOf 提取时间成分
    MathFunction
    DateUtilsFunction
    关于发表评论时的“无法验证数据”的错误
    用ISAPI_Rewrite实现反向代理(ReverseProxy)
    [公告]取消了后台管理中的统计功能
    推荐一个不错的SharePoint文档库树形显示WebPart及谈谈写Blog的好处
    [公告]镜像站点可以登录并发表文章
  • 原文地址:https://www.cnblogs.com/Stefan-Gao/p/14305321.html
Copyright © 2011-2022 走看看