誰可以幫我把我的程序改寫成冒泡排序法。 - VB6论坛

已结贴√ 问题点数：11 回复次数：4

誰可以幫我把我的程序改寫成冒泡排序法。

Option Base 1
Private Sub Form_click()
Dim a%(), imin%, n%, i%, j%, t%, p%
Cls
Randomize
i = InputBox("输入数组的元素个数：")
ReDim a(i)
For j = 1 To i
    a(j) = Int(Rnd * 200 + 1)
Next j
n = UBound(a)
For k = 1 To i
    imin = a(k)
    For j = 1 To i
    If a(j) < a(k) Then
            p = a(j)
            a(j) = a(k)
            a(k) = p
    End If
    Next j
Next k
For i = LBound(a) To UBound(a)
    Print a(i);
    If i Mod 8 = 0 Then Print
Next
End Sub

用泡排序法实现有N个元素数组的排序。N由键盘输入，数组元素的值在1~200之间，随机产生。

搜索更多相关主题的帖子: 冒泡　

第 2 楼

得分:3

看在你这帖子是今天的发贴中算有点意思的份上，就奉上一份冒泡排序及选择排序的函数吧，不知道写对了没有。

程序代码：

Public Function BubbleSort(ByRef src() As Integer) As Long
    Dim n      As Long
    Dim i      As Long
    Dim j      As Long
    Dim bSwrap As Boolean
    Dim swrap  As Long
    
    n = UBound(src)
    Debug.Assert n >= 1
    
    For i = n - 1 To 1 Step -1
        bSwrap = False

        For j = 0 To i

            If src(j) < src(j + 1) Then     '如果降序排列，则替换为<
                bSwrap = True
                swrap = swrap + 1
                src(j) = src(j) + src(j + 1)
                src(j + 1) = src(j) - src(j + 1)
                src(j) = src(j) - src(j + 1)
            End If

        Next

        If Not bSwrap Then

            Exit For

        End If

    Next

    Debug.Print swrap
    BubbleSort = 0
End Function

Public Function SelectSort(ByRef src() As Integer) As Long
    Dim n      As Long
    Dim i      As Long
    Dim j      As Long
    Dim bSwrap As Boolean
    Dim swrap  As Long
    Dim k      As Long

    n = UBound(src)
    Debug.Assert n >= 1

    For i = 0 To n - 1
        k = i

        For j = i + 1 To n

            If src(j) > src(k) Then
                k = j
            End If

        Next

        If k <> i Then
            swrap = swrap + 1
            src(i) = src(i) + src(k)
            src(k) = src(i) - src(k)
            src(i) = src(i) - src(k)
        
        End If

    Next

    Debug.Print swrap
    SelectSort = 0
End Function

SelectSort的效率比bubbleSort快得不是一丁点。。我用5000个随机数的数组测试，bubbleSort共交换 6175945 次，而selectSort只有4975 次。

bubbleSort start:@2010-6-5 16:08:39
6178209
bubleSort end:@2010-6-5 16:08:43

selectSort start:@2010-6-5 16:08:43
4976
selectSort end:@2010-6-5 16:08:44

bubleSort2 start:@2010-6-5 16:08:44
6178209
bubleSort2 end:@2010-6-5 16:08:48

PS：将交换两个数的代码改为最直观的
tmp = src(j)
src(j) = src(j + 1)
src(j + 1) = tmp
，居然快了近1秒。

[ 本帖最后由 jiashie 于 2010-6-5 16:20 编辑 ]

第 3 楼

得分:3

PS：将交换两个数的代码改为最直观的
tmp = src(j)
src(j) = src(j + 1)
src(j + 1) = tmp
，居然快了近1秒。

这句话是费话.

--------------------
            src(i) = src(i) + src(k)
            src(k) = src(i) - src(k)
            src(i) = src(i) - src(k)
这是以节省速度换空间,减少速度以减少空间占用

tmp = src(j)
src(j) = src(j + 1)
src(j + 1) = tmp
这是以空间换速度 ,以增加空间占用,来加快速度.
-----------------------------------------------
比编译来看,
前面那种是不断做寻址和加减法.写入
后面这种只是不断的寻址,写入.
然后后面这种的快,时间就节省在加减法上面.

授人于鱼，不如授人于渔
早已停用QQ了

第 4 楼

得分:0

怎麼會那麼複雜的...有沒簡單點的版本

第 5 楼

得分:3

Option Explicit

Private Sub Form_Activate()
    Dim arr(1 To 20) As Integer, i As Integer, j As Integer, n As Integer, t As Integer
    For i = 1 To 20
        Randomize
        arr(i) = Int(Rnd * 100 + 1)
        Print arr(i);
        n = n + 1
        If n Mod 5 = 0 Then Print
    Next
    Print: Print: n = 0
    For i = 1 To 19
        For j = i + 1 To 20
            If arr(i) > arr(j) Then
                t = arr(i): arr(i) = arr(j): arr(j) = t
            End If
        Next
    Next
    For i = 1 To 20
        Print arr(i);
        n = n + 1
        If n Mod 5 = 0 Then Print
    Next

End Sub

这是用冒泡法排序1-20的代码，在网上找的，不知道对你有用没。回帖是种美德