| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛

80个不重复的随机数.rar (101.15 KB)

Option Explicit
Option Base 1
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Dim a(1 To 7) As Long
Const Nums = 80  '定义一个常量80
Private Sub Command1_Click()
Dim i, j, n, t, k, l As Long
Dim KLB(Nums) As Long  '定义一个变量
Dim s, m As String       '定义字符串
t = timeGetTime
Randomize
For i = 1 To Nums      'i = 1 到 80
n = Int(Rnd * Nums) + 1   'n为随机数
If KLB(n) = 0 Then
KLB(n) = n
If n < 10 Then '判断是否是小于10
n = 0 & n '小于10则在前面加0
End If
s = s & n & " "    's = s & n & vbCrLf
Else
i = i - 1
End If
Next i
Text1.Text = s        't = timeGetTime - t      'MsgBox t
End Sub

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

```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编辑过]

```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," ")

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

'快速排序：
Dim lef,rig
Dim pivot

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,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```

• 9
• 1/1页
• 1