初来乍到，请教怎么给一随机数排序？ - 编程论坛

#2

apull2022-06-17 13:39

控制2个循环变量的范围就行

程序代码：

Private Sub Form_DblClick()
    Const Nums = 80
    Dim KLB(Nums) As Long

    Randomize

    For i = 1 To Nums      'i = 1 到 80
        n = Int(Rnd * Nums) + 1  'n为随机数
        KLB(i) = n
    Next i

    s = ""
    For i = 1 To Nums
        s = s & KLB(i) & " "
    Next i
    Debug.Print s

    l = 10
    h = 30
    For i = l To h - 1
        For j = i To h
            If KLB(i) > KLB(j) Then
                t = KLB(i)
                KLB(i) = KLB(j)
                KLB(j) = t
            End If
        Next j
    Next i

    s = ""
    For i = 1 To Nums
        s = s & KLB(i) & " "
    Next i
    Debug.Print s

End Sub

[此贴子已经被作者于2022-6-17 13:54编辑过]

#3

hxx10212022-06-18 12:26

回复 2楼 apull

谢谢！不过，随机数有重复数字，还没解决。

#4

cwa99582022-06-18 15:28

产生不同的随机数很简单，最简单的方法就是生产一个随机数，与已经生成的作比较，相同的就pass。

#5

约定的童话2022-06-18 21:26

回复 3楼 hxx1021

想不随机引入字典，随机一个字典没有的就存字典，字典已有的就返回去重新随机

#6

龙胆草2022-06-19 11:28

回复 5楼约定的童话

在这里又碰到兄台了,哈哈,在EH常见你

#7

yuma2022-06-21 17:50

程序代码：

Option Explicit

'接收输入：
Dim s, r, n, i
s=inputbox(vbcrlf & vbcrlf & "以空格隔开：","请输入一组数字或字符串：","? + A # 201 * c2 1 $ b 18 / ( A23 _ 15 A1 a1 & \ @ ~  ) - = ^ 4D ? 35 , 67 ! CB 21 % 10")
If s = "" Then wscript.quit
r = Split(s, " ")
n = UBound(r)
'把字符串转换为Double 子类型：
'For i = 0 To n
'    r(i) = CDBL(r(i))
'Next

'快速排序方法调用：
quicksort r, 0, n  '快速排序
'其它排序方法的调用：
'insertsort r  '插入排序
'shellsort r  '希尔排序
'bubblesort r  '冒泡排序
'selectsort r  '选择排序
'heapsort r  '堆排序

'输出结果：
inputbox vbcrlf & vbcrlf & "按升序排列是：","结果",join(r," ")

'各种排序子过程自定义：

'快速排序：
Sub quicksort(ReArr, head, tail)
'ReArr是待排序数组，head和tail是该数组的最小下标和最大下标
Dim lef,rig
Dim pivot

If head<tail Then
lef=head
rig=tail
pivot=ReArr(lef)
While (lef<>rig)

While (lef<rig and ReArr(rig)>=pivot)
rig=rig-1
Wend
If lef<rig Then
ReArr(lef)=ReArr(rig)
lef=lef+1
End If

While (lef<rig and ReArr(lef)<=pivot)
lef=lef+1
Wend

If lef<rig Then
ReArr(rig)=ReArr(lef)
rig=rig-1
End If
Wend

ReArr(lef)=pivot
call quicksort(ReArr,head,lef-1)
call quicksort(ReArr,lef+1,tail)

End If
End Sub

'插入排序：
Sub insertsort(r)
        Dim i, n, t, j
        n = UBound(r)
        For i = 1 To n '依次插入r(1),r(2),...,r(n)
                t = r(i)
                j = i - 1
                Do While t < r(j) '查找r(i)的插入位置
                        r(j + 1) = r(j) '将大于r(i)的数后移
                        j = j - 1
                        If j = -1 Then Exit Do
                Loop
                r(j + 1) = t '插入r(i)
        Next
End Sub

'希尔排序：
Sub shellsort(r)
                '设置增量序列：
        Dim i, d(), n, t, k, h, j
        n = UBound(r)
        i = 0
        ReDim d(n)
        d(i) = Fix(n / 2)
        Do Until d(i) = 1
                t = d(i)
                i = i + 1
                d(i) = Fix(t / 2)
        Loop
                '排序：
        k = 0
        Do
                h = d(k) '取本趟增量
                For i = h To n 'r(h)到r(n)插入当前有序区
                        t = r(i) '保存待插入数
                        j = i - h
                        Do While t < r(j) '查找正确的插入位置
                                r(j + h) = r(j) '后移
                                j = j - h '得到前一数的位置
                                If j < 0 Then Exit Do
                        Loop
                        r(j + h) = t '插入r(i)
                Next '本趟排序完成
                k = k + 1
        Loop While h <> 1
End Sub

'冒泡排序：
Sub bubblesort(r)
        Dim i, n, noswap, j, t
        n = UBound(r)
        For i = 0 To n - 1 '做n趟排序
                noswap = True '置未交换标志
                For j = n - 1 To i Step -1 '从下往上扫描
                        If r(j + 1) < r(j) Then '交换
                                t = r(j)
                                r(j) = r(j + 1)
                                r(j + 1) = t
                                noswap = False
                        End If
                Next
                If noswap Then Exit For '本趟排序中未发生交换则终止算法
        Next
End Sub

'快速排序：
        '划分：
Function partition(r, l, h)
        Dim i, j, t
        i = l
        j = h
        t = r(i) '初始化，t为基准
        Do
                While r(j) >= t And i < j
                        j = j - 1 '从右向左扫描，查找第1个小于t的数
                Wend
                If i < j Then
                        r(i) = r(j) '交换r(i)和r(j)
                        i = i + 1
                End If
                While r(i) <= t And i < j
                        i = i + 1 '从左向右扫描，查找第1个大于t的数
                Wend
                If i < j Then
                        r(j) = r(i) '交换r(i)和r(j)
                        j = j - 1
                End If
        Loop While i <> j
        r(i) = t '基准t已被最后定位
        partition = i
End Function

'选择排序：
Sub selectsort(r)
        Dim i, n, k, j, t
        n = UBound(r)
        For i = 0 To n - 1 '做n趟排序
                k = i
                For j = i + 1 To n '在当前无序区选最小的数r(k)
                        If r(j) < r(k) Then k = j
                Next
                If k <> i Then
                        t = r(i)
                        r(i) = r(k)
                        r(k) = t
                End If
        Next
End Sub

'堆排序：
        '筛选：
Sub sift(r, i, m) '以r(i)为根的完全二叉树构成堆
        Dim t, j
        t = r(i)
        j = 2 * i
        Do While j <= m 'j<=m,r(2*i)是r(i)的左孩子
                If j < m Then
                        If r(j) < r(j + 1) Then j = j + 1 'j指向r(i)的右孩子
                End If
                If t < r(j) Then '孩子节点的数较大
                        r(i) = r(j) '将r(j)换到双亲位置上
                        i = j '修改当前被调整节点
                        j = 2 * i
                Else
                        Exit Do '调整完毕，退出循环
                End If
        Loop
        r(i) = t '最初被调整节点放入正确位置
End Sub
Sub heapsort(r)
        Dim i, n, t
        n = UBound(r)
        For i = Fix(n / 2) To 0 Step -1 '建初始堆
                sift r, i, n
        Next
        For i = n To 0 Step -1 '进行n+1趟排序
                t = r(0) '当前堆顶数和最后一个数交换
                r(0) = r(i)
                r(i) = t
                sift r, 0, i - 1 'r(0)到r(i-1)重建成堆
        Next
End Sub

#8

独木星空2022-06-22 15:33

一个好的问题是练手的好帮手。解决一个问题也是对自己实力的提升。

#9

sssooosss2022-06-22 19:29

共同学习

#10

冬瓜汤2023-02-10 01:22

例2：回调函数的调用。比如qsort 给vb的数组排序。这个我们在普通使用中，估计会用得很多。

Public Declare Sub qsort CDecl Lib "msvcrt" ( _

                         ByRef pFirst As Any, _

                         ByVal lNumber As Long, _

                         ByVal lSize As Long, _

                         ByVal pfnComparator As Long)

Sub Main()

    Dim z() As Long

    Dim i As Long

    Dim s As String

    ReDim z(500)

    For i = 0 To UBound(z)

        z(i) = Int(Rnd * 10000)

    Next

    qsort z(0), UBound(z) + 1, LenB(z(0)), AddressOf Comparator

    For i = 0 To UBound(z)

        Debug.Print z(i)

    Next

End Sub

Private Function Comparator CDecl( _

                 ByRef a As Long, _

                 ByRef b As Long) As Long

    Comparator = a - b

End Function

vb数组的排序非常的快。

通过以上例子，我们可以看出，在使用c/c++ 的函数时，指针会用得很频繁，一般强烈建议把指针用longptr来替换long，这样子代码易读性一目了然。强烈推荐 msvbvm60.tlb里的指针系列函数，会带来非常方便的指针操作。

vb6的cdecl补丁下载地址：https://wwi.
其它例子详见：Vb/vba 与cdecl的故事 http://www.

[此贴子已经被作者于2023-2-19 12:57编辑过]

#11

cmarlboro2023-02-10 15:05

菜鸟，来学习的

#12

cuituo2023-02-11 01:02

有个算法叫做洗牌算法，就是对已知数组排序的

#13

yuma2023-02-11 15:12

回复 12楼 cuituo

洗牌算法是随机打乱

#14

yuma2023-02-11 17:06

你想要

生成N个不重复的随机数

还是

给随机数从大到小，从小到大排序

还是

给随机数随机打乱