• 按键公众号 :
按键精灵电脑版
立即下载

软件版本:2014.06
软件大小:22.9M
更新时间:2021-12-03

按键精灵安卓版
立即下载

软件版本:3.7.2
软件大小:46.2M
更新时间:2023-05-10

按键精灵iOS版
立即下载

软件版本:1.8.0
软件大小:29.2M
更新时间:2023-03-21

按键手机助手
立即下载

软件版本:3.8.0
软件大小:262M
更新时间:2023-05-30

快捷导航

登录 后使用快捷导航
没有帐号? 注册

发新话题 回复该主题

[老狼] [老狼][源码分享]----排序算法的魅力----遇见蔷薇泡沫(37) [复制链接]

1#
最常用的排序1[冒泡排序]:
  1. 字符串 = "4,3,10,5,8,7,5,0,10"
  2. 变量 = split(字符串, ",")
  3. For a = 0 To UBound(变量)
  4. For b = 0 To UBound(变量)
  5. If Int(变量(a)) < Int(变量(b)) Then '改<可从小到大排序
  6. 冒泡 = 变量(a)
  7. 变量(a) = 变量(b)
  8. 变量(b) = 冒泡
  9. End If
  10. Next
  11. Next
  12. TracePrint join(变量,",")
复制代码
最常用的排序2[冒泡排序]:(其实对比并不限于数字)
  1. a=array("A001","B001","D118A","D118B","A009","B020","A020","B055","A050")
  2. for i=0 to ubound(a)-1
  3. For n = i + 1 To ubound(a)
  4. if a(i)<a(n) then
  5. s=a(i)
  6. a(i)=a(n)
  7. a(n)=s
  8. end if
  9. next
  10. next
  11. TracePrint join(a," ")
复制代码

结构数组排序1:(返回数字大小=值格式)
  1. 数字="100=A|50=B|1=C|0=D|10=E|20=F|12=G|21=H"
  2. 数组=Split(数字,"|")
  3. 返回值= lib.算法.结构数组排序(数组,0)//参数2:[0全部1最小2最大]
  4. TracePrint 返回值//返回格式"数字大小=值"


  5. 返回值 = Lib.算法.结构数组排序(数组, 1)//参数2:[0全部1最小2最大]
  6. 分割=split(返回值,"=")
  7. TracePrint 分割(0)'返回最小值
  8. TracePrint 分割(1)'返回对应值
复制代码

结构数组排序2:(其实并不一定要使用数字="100=A|50=B|1=C|0=D|10=E|20=F|12=G|21=H"这种格式)
  1. Randomize
  2. 个数 = Int((100 * Rnd) + 1)
  3. For 个数'生成个数
  4. Randomize '随机
  5. Var2 = Int(50 * Rnd)'0-50
  6. 数字=数字&Var2&"|"
  7. Next
  8. TracePrint 数字
  9. 数字=mid(数字,1,len(数字)-1)
  10. 数组 = Split(数字, "|")
  11. Var3= Replace(Lib.算法.结构数组排序(数组, 0)," ",",")
  12. TracePrint Var3
复制代码

箱排序:(最容易理解、最快排序)
  1. t1= Timer
  2. 数组 = array(1, 5, 7, 4, 10000, 96, 5)
  3. Dim Var()
  4. Redim Preserve Var(0)
  5. For i = 0 To UBound(数组)
  6. If UBound(Var) <数组(i) Then
  7. Redim Preserve Var(数组(i))
  8. End If
  9. Var(数组(i)) = Var(数组(i)) & 数组(i) & "|"
  10. Next
  11. TracePrint Join(Var, "")
  12. TracePrint Timer-t1
复制代码

--------------------------------------------------------------------------------------------------
注:以下代码来源于收集(这些年论坛丢失了太多资料)
--------------------------------------------------------------------------------------------------
  1. 【冒泡排序】
  2. GG = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 0)
  3. MsgBox bubblesort(Join(GG, " ")),64+4096,"bubblesort"
  4. '
  5. Function bubblesort(Join_Arr_Space) '冒泡排序
  6. Dim i, j, Arr, n, noswap
  7. Arr=Split(Join_Arr_Space," ")
  8. n=ubound(Arr)
  9. for i=0 to n-1'做n趟排序
  10. noswap=True'置未交换标志
  11. for j=n-1 to i step -1'从下往上扫描
  12. if Arr(j+1)<Arr(j) then'交换
  13. t=Arr(j)
  14. Arr(j)=Arr(j+1)
  15. Arr(j+1)=t
  16. noswap=False
  17. end if
  18. next
  19. if noswap then exit for'本趟排序中未发生交换则终止算法
  20. Next
  21. bubblesort=Join(Arr," ")
  22. End Function
复制代码
  1. 【快速排序】
  2. n = Array(96,85,77,100,40,59,59,62,80,71) 'n为对象数组
  3. Call Quicksort(0, Ubound(n)) '调用快速排序
  4. Msgbox Join(n, ","),64+4096,"原始数组"
  5. MsgBox Join(n, ","),64+4096,"快速排序结果 从小到大"
  6. MsgBox Join(Convert(n), ","),64+4096,"快速排序结果 从大到小"
  7. '
  8. Function Quicksort(p, r) '快速排序
  9. If p < r Then
  10. q = Partition(p, r)
  11. Quicksort p, q - 1
  12. Quicksort q + 1, r
  13. End If
  14. End Function
  15. Function Partition(p, q) '配合替换
  16. Dim x, i, j
  17. x = n(p)
  18. i = p
  19. For j = p + 1 To q
  20. If n(j) <= x Then
  21. i = i + 1
  22. a=n(i)
  23. n(i)=n(j)
  24. n(j)=a
  25. End If
  26. Next
  27. a=n(p)
  28. n(p)=n(i)
  29. n(i)=a
  30. Partition = i
  31. End Function
  32. Function Convert(ArrayName) '数组元素反序
  33. For i = 0 To UBound(ArrayName)
  34. Redim Preserve u9(i)
  35. u9(i)=ArrayName(UBound(ArrayName)-i)
  36. Next
  37. Convert=u9
  38. End Function
复制代码
  1. 【选择排序】
  2. GG = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 0)
  3. MsgBox selectsort(Join(GG, " ")),64+4096,"selectsort"
  4. '
  5. Function selectsort(Join_Arr_Space) '选择排序
  6. Dim n, k, j, Arr, t
  7. Arr=Split(Join_Arr_Space," ")
  8. n=ubound(Arr)
  9. for i=0 to n-1'做n趟排序
  10. k=i
  11. for j=i+1 to n'在当前无序区选最小的数r(k)
  12. if Arr(j)<Arr(k) then k=j
  13. next
  14. if k<>i then
  15. t=Arr(i)
  16. Arr(i)=Arr(k)
  17. Arr(k)=t
  18. end if
  19. Next
  20. selectsort=Join(Arr," ")
  21. End Function
复制代码
  1. 【计数排序】
  2. a=Array(2,5,1,12,34,56,7,8,9,3333,6)
  3. TracePrint Join(数组重排序(a,0))
  4. TracePrint Join(数组重排序(a,1))
  5. Function 数组重排序(数组,模式)'0是从小到大,1是从大到小
  6. i = 0
  7. While i < UBound(数组)
  8. If 模式 = 0 Then
  9. If 数组(i) > 数组(i + 1) Then
  10. temp = 数组(i)
  11. 数组(i) = 数组(i + 1)
  12. 数组(i + 1) = temp
  13. i = i - 2
  14. If i < 0 Then
  15. i = - 1
  16. End If
  17. End If
  18. ElseIf 模式 = 1 Then
  19. If 数组(i) < 数组(i + 1) Then
  20. temp = 数组(i)
  21. 数组(i) = 数组(i + 1)
  22. 数组(i + 1) = temp
  23. i = i - 2
  24. If i < 0 Then
  25. i = - 1
  26. End If
  27. End If
  28. End If
  29. i = i + 1
  30. Wend
  31. 数组重排序=数组
  32. End Function
复制代码
  1. 【另类排序】
  2. 'CreateObject( "System.Collections.ArrayList" )调用了mscoree.dll,是.NET Framework相关组件。
  3. myarray=Array(96,85,77,100,40,59,59,62,80,71)
  4. MsgBox myarray(0)
  5. MsgBox fSortArray(myarray)(0)
  6. Function fSortArray(aSortThisArray)
  7. Dim oArrayList, iElement
  8. Set oArrayList = CreateObject("System.Collections.ArrayList")
  9. For iElement = 0 To UBound(aSortThisArray)
  10. oArrayList.Add aSortThisArray(iElement)
  11. Next
  12. oArrayList.Sort
  13. set fSortArray = oArrayList
  14. End Function
  15. '
  16. Function fSortArray(aSortThisArray)
  17. Dim oArrayList, iElement
  18. Set oArrayList = CreateObject( "System.Collections.ArrayList" )
  19. For iElement = 0 To UBound(aSortThisArray)
  20. oArrayList.Add aSortThisArray(iElement)
  21. Next
  22. oArrayList.Sort
  23. set fSortArray = oArrayList
  24. End Function
复制代码
  1. 【利用Excel排序】
  2. '按键精灵调用Excel对Txt文件内容进行排序, 速度绝对快。http://bbs.anjian.com/thread-203355-1-1.html
  3. '生成未排序的测试TXT文件
  4. Dim fso,fs,i
  5. Randomize
  6. Set fso = CreateObject("Scripting.FileSystemObject")
  7. Set fs = fso.CreateTextFile("C:\Test.txt",True) ' "C:\Test.txt" 可以改为自己针对的对象文件
  8. For i = 1 To 5000
  9. fs.Write Int(Rnd* 10000+1) & VbCrlf
  10. Next
  11. fs.Close
  12. ' 结合Excel进行排序, 回复可见
  13. Dim xlA,xlB,xlS,xlR,xlT
  14. Set xlA = CreateObject("Excel.Application")
  15. Set xlB = xlA.Workbooks.Open("C:\Test.txt") ' "C:\Test.txt" 可以改为自己针对的对象文件
  16. Set xlS = xlB.Worksheets(1)
  17. Set xlR = xlS.UsedRange
  18. Set xlT = xlA.Range("A1")
  19. xlR.Sort(xlT)
  20. xlB.Save
  21. xlB.Close
  22. xlA.Quit
复制代码
【插入排序】
Arr = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 0)
Msgbox insertsort(join(Arr, " ")),64+4096,"insertsort"
'
Function insertsort(Join_Arr_Space) '直接插入排序
Dim i,j,ArrName,Tmp
ArrName=Split(Join_Arr_Space," ")
For i=1 to ubound(ArrName) '依次插入数组元素
Tmp=ArrName(i)
j=i-1
Do while Tmp<ArrName(j)'查找ArrName(i)的插入位置
ArrName(j+1)=ArrName(j)'将大于ArrName(i)的数后移
j=j-1
if j=-1 Then Exit Do
Loop
ArrName(j+1)=Tmp '插入ArrName(i)
Next
insertsort=Join(ArrName," ")
End Function

【希尔排序】
GG = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 0)
MsgBox shellsort(Join(GG, " ")),64+4096,"shellsort"
'
Function shellsort(Join_Arr_Space) '希尔排序
Dim i, j, Arr, t, k, h
Arr=Split(Join_Arr_Space," ")
n = ubound(Arr)
i=0
Redim d(ubound(Arr))
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 'Arr(h)到Arr(n)插入当前有序区
t=Arr(i) '保存待插入数
j=i-h
do while t<Arr(j) '查找正确的插入位置
Arr(j+h)=Arr(j) '后移
j=j-h '得到前一数的位置
if j<0 then exit do
loop
Arr(j+h)=t '插入Arr(i)
next '本趟排序完成
k=k+1
loop while h<>1
shellsort=join(Arr, " ")
End Function

【堆排序】
GG = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 0)
MsgBox heapsort(join(GG, " ")), 64 + 4096, "heapsort"
'
Function heapsort(Join_Arr_Space) '堆排序
Arr = Split(Join_Arr_Space, " ")
VBSBegin
sub sift(Arr,i,m) '堆排序 以Arr(i)为根的完全二叉树构成堆
n=ubound(Arr)
dim t,j
t=Arr(i)
j=2*i
do while j<=m 'j<=m,Arr(2*i)是Arr(i)的左孩子
if j<m then
if Arr(j)<Arr(j+1) then j=j+1 'j指向Arr(i)的右孩子
end if
if t<Arr(j) then'孩子节点的数较大
Arr(i)=Arr(j) '将Arr(j)换到双亲位置上
i=j '修改当前被调整节点
j=2*i
else
exit do '调整完毕,退出循环
end if
loop
Arr(i)=t '最初被调整节点放入正确位置
End Sub
sub vbs_heapsort(Arr)
dim i,n,t
n=ubound(Arr)
for i=fix(n/2) to 0 step -1 '建初始堆
sift Arr,i,n
next
for i=n to 0 step -1 '进行n+1趟排序
t=Arr(0) '当前堆顶数和最后一个数交换
Arr(0)=Arr(i)
Arr(i)=t
sift Arr,0,i-1 'Arr(0)到Arr(i-1)重建成堆
next
End Sub
VBSEnd
vbs_heapsort Arr 'VBS块结束后才可调用其中函数、子程序
heapsort=Join(Arr," ")
End Function

最后编辑瑞祥幽冥狼 最后编辑于 2022-03-20 23:36:16
本主题由 超级版主 瑞祥幽冥狼 于 2023/10/5 18:33:21 执行 审核帖子 操作
收 徒 索 引 ← ← ← ← ← ← ← ← ← ← 点 击

个 人 Q Q 1 : 1 2 2 3 1 1 6 6 1 8[将满]
个 人 Q Q 2 : 6 1 7 0 9 5 5 4 3[可加]
2#

sdssd

3#

66666666666

4#

你这真是要啥有啥

5#

6666666666666666666666666666666

6#

阿萨飒飒的

7#

喜欢各类排序

8#

厉害

9#

fsafdsaf

10#

qqfqfqfqf

11#

排序算法

12#

学习看看

13#

洗洗头发杨采钰

14#

永远滴神

15#

第三方红发歌姬风刀霜剑个梵蒂冈

16#


17#

支持源代码

18#

h还隐藏了什么黑科技吗

19#

111111111111111111111111

发新话题 回复该主题