演示冒泡法排序过程 (2)

 'Excel宏代码原创分享，转发请注明来源，作者：王欢为，WX：13772568903。

功能：演示冒泡法排序过程(2)。此过程相对于前一个演示，稍微修改了一些，眼睛看着会感觉效率提高了，真正运行起来，感觉效率并不会提高太多，只有当大数基本上处于原数列后方的时候，效率才会明显提高。比如：原数列就是已经排好的数列，或者极少的数字是没有排好的，这时候用今天演示的这个方法，速度会明显提升。

改进的原理：

将所有数据分为三段，最下面排好序的数字称为淤泥，中间没排好序的数字称为水，最上面排好序的数字称为气泡。刚开始只有水。

步骤1：判断是否只有1层水，是则将水变成淤泥，排序结束；否则执行步骤2。

步骤2：判断底层的水是否比他上方与他相邻的一层水重，是则将底层的水变成淤泥，重复步骤1；否则将顶层的淤泥变成水(如果没有淤泥就不用变了)，将底层的水变成气泡，执行步骤3。

步骤3：判断气泡是否比他上面一层水轻，是则气泡和水交换位置，执行步骤4；否则将气泡变成水，将原气泡上方的水变成气泡。执行步骤4。

步骤4：判断气泡是否到达水的顶层，是则执行步骤1；否则执行步骤3。

特点：1．演示的过程实际上也是排序的过程，既能看到数字排序的过程，同时也能看到色块排序的过程。

特点：2．用来排序的数字的多少，数字的分布可以手动设置，也可以随机设置。做到随心测试。

操作：在Sub Yanshi1()中修改参数后(如果不想修改也可以不修改)，点击运行，然后就可以在当前工作表中观看动画过程了。

Option Explicit
Dim Hang1&, Hang2&, Lie1&, Zhenshu1#, Shoudong1%
Sub Yanshi1()
    'Excel宏代码原创分享，转发请注明来源，作者：王欢为，WX：13772568903。
    '演示冒泡法进行排序的过程，演示的是升序排列过程。
    Lie1 = 4 '数据所在列号，可以手动修改
    Hang1 = 3 '数据起始行号，可以手动修改
    Hang2 = 20 '数据末尾列号，可以手动修改
    Zhenshu1 = 5 '每秒帧数，仅供参考，可以手动修改
    Shoudong1 = 0 '是否手动输入数据，1为手动，0为自动。
    '如果手动输入数据，需要先全选excel当前工作表，删除 _
    现有数据及背景，然后在Cells(Hang1,Lie1)和Cells(Hang2,Lie1) _
    之间的单元格输入数字，留空的单元格程序会随机补充 _
    0～255之间的数字。
    Call CCYanshimaopaofapaixu2
End Sub
'以上为参数设置部分，其中Lie1最少为4， _
如果给的数字小于4，运行过程中会强制改为4。
Private Sub CCYanshimaopaofapaixu2()
    If Shoudong1 = 0 Then
        Cells.Delete
    End If
    Cells.Borders.LineStyle = xlContinuous '设置边框
    Dim ii&, Time1, Num1#, Num2#, Num3#, Num4%, Hang3
    If Lie1 < 4 Then
        Lie1 = 4
    End If
    Time1 = 1 / Zhenshu1
    Num1 = 8.8E+307
    Num2 = -8.8E+307
    For ii = Hang1 To Hang2
        If Len(Cells(ii, Lie1)) > 0 Then
            Num3 = Val(Cells(ii, Lie1))
        Else
            Num3 = Int(Rnd() * 256)
            Cells(ii, Lie1) = Num3
        End If
        If Num1 > Num3 Then
            Num1 = Num3
        End If
        If Num2 < Num3 Then
            Num2 = Num3
        End If
    Next ii
    If Num1 < Num2 Then
        Num3 = 255.99 / (Num2 - Num1)
        For ii = Hang1 To Hang2
            Num4 = Int(Num3 * (Cells(ii, Lie1) - Num1))
            Cells(ii, Lie1 - 1).Interior.Color = _
            RGB(255, 255 - Num4, Num4)
        Next ii
    Else
        For ii = Hang1 To Hang2 '设置单元格底色为白色
            Cells(ii, Lie1 - 1).Interior.Color = RGB(255, 255, 255)
        Next ii
    End If
    Cells(1, Lie1) = "冒泡法排序演示"
    'Cells(2, Lie1 - 1) = "作者：王欢为，13772568903"
    Hang3 = Hang2
Biaoji1:
    ii = Hang3
    Do While Hang1 < Hang3
        Call CCdengdai(2 * Time1)
        If Cells(ii, Lie1) < Cells(ii - 1, Lie1) Then
            Cells(ii, Lie1).Interior.Pattern = xlNone
            If Hang3 < Hang2 Then
                Hang3 = Hang3 + 1
            End If
            Exit Do
        Else
            Cells(ii, Lie1).Interior.Color = RGB(0, 0, 255) '设置单元格底色为蓝色
            Hang3 = Hang3 - 1
            ii = ii - 1
        End If
    Loop
    Do While Hang1 < Hang3
        Cells(ii + 1, Lie1).Interior.Pattern = xlNone
        Cells(ii, Lie1).Interior.Color = RGB(255, 0, 0) '设置单元格底色为红色
        Call CCdengdai(2 * Time1)
        If Cells(ii, Lie1) < Cells(ii - 1, Lie1) Then
            Call CCjiaohuan(ii - 1, ii, Lie1, Time1)
        End If
        ii = ii - 1
        If ii = Hang1 Then
            Hang1 = Hang1 + 1
            Cells(ii, Lie1).Interior.Color = RGB(0, 0, 255) '设置单元格底色为蓝色
            Call CCdengdai(2 * Time1)
            GoTo Biaoji1
        End If
    Loop
    Cells(Hang3 - 1, Lie1).Interior.Color = RGB(0, 0, 255) '设置单元格底色为蓝色
    Call CCdengdai(2 * Time1)
    Cells(Hang3, Lie1).Interior.Color = RGB(0, 0, 255) '设置单元格底色为蓝色
    Call CCdengdai(2 * Time1)
End Sub
Private Sub CCjiaohuan(Row1, Row2, Col1, Time1)
    Dim Str1$, BucRow1&, ii&
    Cells(Row1, Col1).Interior.Color = RGB(0, 255, 0) '设置单元格底色为绿色
    Call CCdengdai(Time1)
    Call CCyidong(Row1, Col1, Row1, Col1 + 1, Time1)
    Cells(Row2, Col1).Interior.Color = RGB(255, 0, 0)  '设置单元格底色为红色
    Call CCdengdai(Time1)
    Call CCyidong(Row2, Col1, Row1, Col1, Time1)
    Call CCyidong(Row1, Col1 + 1, Row2, Col1 + 1, Time1)
    Call CCyidong(Row2, Col1 + 1, Row2, Col1, Time1)
    Cells(Row2, Col1).Interior.Pattern = xlNone
End Sub
Private Sub CCyidong(Row1, Col1, Row2, Col2, Time1)
    If Len(Cells(Row1, Col1)) > 0 Then
        Cells(Row2, Col2) = Cells(Row1, Col1)
        Cells(Row1, Col1) = ""
    End If
    Cells(Row2, Col2).Interior.Color = Cells(Row1, Col1).Interior.Color
    Cells(Row1, Col1).Interior.Pattern = xlNone
    Cells(Row2, 2 * Lie1 - 1 - Col2).Interior.Color = Cells(Row1, 2 * Lie1 - 1 - Col1).Interior.Color
    Cells(Row1, 2 * Lie1 - 1 - Col1).Interior.Pattern = xlNone
    Call CCdengdai(Time1)
End Sub
Private Sub CCdengdai(ByVal dS As Double)
    Dim sTimer As Date
    sTimer = Timer
    Do While Format((Timer - sTimer), "0.00") < dS
        DoEvents
    Loop
End Sub
Sub maopaofapaixu()
    '演示冒泡法进行排序的过程，演示的是升序排列过程。
    Lie1 = 4 '数据所在列号
    Hang1 = 3 '数据起始行号
    Hang2 = 20 '数据末尾列号
    Zhenshu1 = 30 '每秒帧数，仅供参考。
    Call CCyunxing
End Sub

本例视频演示

https://v.youku.com/v_show/id_XNTgwMzM0NTQxMg==.html