- 超级版主
- 1228894
- 26984
- 25
- 8059 朵
- 36138 个
- 4755 个
- 421340
- 2012-07-18
|
1#
t
T
发表于 2022-03-20 23:17
|
|只看楼主
最常用的排序1[冒泡排序]:- 字符串 = "4,3,10,5,8,7,5,0,10"
- 变量 = split(字符串, ",")
- For a = 0 To UBound(变量)
- For b = 0 To UBound(变量)
- If Int(变量(a)) < Int(变量(b)) Then '改<可从小到大排序
- 冒泡 = 变量(a)
- 变量(a) = 变量(b)
- 变量(b) = 冒泡
- End If
- Next
- Next
- TracePrint join(变量,",")
复制代码 最常用的排序2[冒泡排序]:(其实对比并不限于数字)- a=array("A001","B001","D118A","D118B","A009","B020","A020","B055","A050")
- for i=0 to ubound(a)-1
- For n = i + 1 To ubound(a)
- if a(i)<a(n) then
- s=a(i)
- a(i)=a(n)
- a(n)=s
- end if
- next
- next
- TracePrint join(a," ")
复制代码 结构数组排序1:(返回数字大小=值格式)- 数字="100=A|50=B|1=C|0=D|10=E|20=F|12=G|21=H"
- 数组=Split(数字,"|")
- 返回值= lib.算法.结构数组排序(数组,0)//参数2:[0全部1最小2最大]
- TracePrint 返回值//返回格式"数字大小=值"
- 返回值 = Lib.算法.结构数组排序(数组, 1)//参数2:[0全部1最小2最大]
- 分割=split(返回值,"=")
- TracePrint 分割(0)'返回最小值
- TracePrint 分割(1)'返回对应值
复制代码 结构数组排序2:(其实并不一定要使用数字="100=A|50=B|1=C|0=D|10=E|20=F|12=G|21=H" 这种格式)- Randomize
- 个数 = Int((100 * Rnd) + 1)
- For 个数'生成个数
- Randomize '随机
- Var2 = Int(50 * Rnd)'0-50
- 数字=数字&Var2&"|"
- Next
- TracePrint 数字
- 数字=mid(数字,1,len(数字)-1)
- 数组 = Split(数字, "|")
- Var3= Replace(Lib.算法.结构数组排序(数组, 0)," ",",")
- TracePrint Var3
复制代码 箱排序:(最容易理解、最快排序) - t1= Timer
- 数组 = array(1, 5, 7, 4, 10000, 96, 5)
- Dim Var()
- Redim Preserve Var(0)
- For i = 0 To UBound(数组)
- If UBound(Var) <数组(i) Then
- Redim Preserve Var(数组(i))
- End If
- Var(数组(i)) = Var(数组(i)) & 数组(i) & "|"
- Next
- TracePrint Join(Var, "")
- TracePrint Timer-t1
复制代码-------------------------------------------------------------------------------------------------- 注:以下代码来源于收集(这些年论坛丢失了太多资料)-------------------------------------------------------------------------------------------------- - 【冒泡排序】
- GG = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 0)
- MsgBox bubblesort(Join(GG, " ")),64+4096,"bubblesort"
- '
- Function bubblesort(Join_Arr_Space) '冒泡排序
- Dim i, j, Arr, n, noswap
- Arr=Split(Join_Arr_Space," ")
- n=ubound(Arr)
- for i=0 to n-1'做n趟排序
- noswap=True'置未交换标志
- for j=n-1 to i step -1'从下往上扫描
- if Arr(j+1)<Arr(j) then'交换
- t=Arr(j)
- Arr(j)=Arr(j+1)
- Arr(j+1)=t
- noswap=False
- end if
- next
- if noswap then exit for'本趟排序中未发生交换则终止算法
- Next
- bubblesort=Join(Arr," ")
- End Function
复制代码- 【快速排序】
- n = Array(96,85,77,100,40,59,59,62,80,71) 'n为对象数组
- Call Quicksort(0, Ubound(n)) '调用快速排序
- Msgbox Join(n, ","),64+4096,"原始数组"
- MsgBox Join(n, ","),64+4096,"快速排序结果 从小到大"
- MsgBox Join(Convert(n), ","),64+4096,"快速排序结果 从大到小"
- '
- Function Quicksort(p, r) '快速排序
- If p < r Then
- q = Partition(p, r)
- Quicksort p, q - 1
- Quicksort q + 1, r
- End If
- End Function
- Function Partition(p, q) '配合替换
- Dim x, i, j
- x = n(p)
- i = p
- For j = p + 1 To q
- If n(j) <= x Then
- i = i + 1
- a=n(i)
- n(i)=n(j)
- n(j)=a
- End If
- Next
- a=n(p)
- n(p)=n(i)
- n(i)=a
- Partition = i
- End Function
- Function Convert(ArrayName) '数组元素反序
- For i = 0 To UBound(ArrayName)
- Redim Preserve u9(i)
- u9(i)=ArrayName(UBound(ArrayName)-i)
- Next
- Convert=u9
- End Function
复制代码- 【选择排序】
- GG = Array(1, 3, 5, 7, 9, 2, 4, 6, 8, 0)
- MsgBox selectsort(Join(GG, " ")),64+4096,"selectsort"
- '
- Function selectsort(Join_Arr_Space) '选择排序
- Dim n, k, j, Arr, t
- Arr=Split(Join_Arr_Space," ")
- n=ubound(Arr)
- for i=0 to n-1'做n趟排序
- k=i
- for j=i+1 to n'在当前无序区选最小的数r(k)
- if Arr(j)<Arr(k) then k=j
- next
- if k<>i then
- t=Arr(i)
- Arr(i)=Arr(k)
- Arr(k)=t
- end if
- Next
- selectsort=Join(Arr," ")
- End Function
复制代码- 【计数排序】
- a=Array(2,5,1,12,34,56,7,8,9,3333,6)
- TracePrint Join(数组重排序(a,0))
- TracePrint Join(数组重排序(a,1))
- Function 数组重排序(数组,模式)'0是从小到大,1是从大到小
- i = 0
- While i < UBound(数组)
- If 模式 = 0 Then
- If 数组(i) > 数组(i + 1) Then
- temp = 数组(i)
- 数组(i) = 数组(i + 1)
- 数组(i + 1) = temp
- i = i - 2
- If i < 0 Then
- i = - 1
- End If
- End If
- ElseIf 模式 = 1 Then
- If 数组(i) < 数组(i + 1) Then
- temp = 数组(i)
- 数组(i) = 数组(i + 1)
- 数组(i + 1) = temp
- i = i - 2
- If i < 0 Then
- i = - 1
- End If
- End If
- End If
- i = i + 1
- Wend
- 数组重排序=数组
- End Function
复制代码- 【另类排序】
- 'CreateObject( "System.Collections.ArrayList" )调用了mscoree.dll,是.NET Framework相关组件。
- myarray=Array(96,85,77,100,40,59,59,62,80,71)
- MsgBox myarray(0)
- MsgBox fSortArray(myarray)(0)
- Function fSortArray(aSortThisArray)
- Dim oArrayList, iElement
- Set oArrayList = CreateObject("System.Collections.ArrayList")
- For iElement = 0 To UBound(aSortThisArray)
- oArrayList.Add aSortThisArray(iElement)
- Next
- oArrayList.Sort
- set fSortArray = oArrayList
- End Function
- '
- Function fSortArray(aSortThisArray)
- Dim oArrayList, iElement
- Set oArrayList = CreateObject( "System.Collections.ArrayList" )
- For iElement = 0 To UBound(aSortThisArray)
- oArrayList.Add aSortThisArray(iElement)
- Next
- oArrayList.Sort
- set fSortArray = oArrayList
- End Function
复制代码- 【利用Excel排序】
- '按键精灵调用Excel对Txt文件内容进行排序, 速度绝对快。http://bbs.anjian.com/thread-203355-1-1.html
- '生成未排序的测试TXT文件
- Dim fso,fs,i
- Randomize
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set fs = fso.CreateTextFile("C:\Test.txt",True) ' "C:\Test.txt" 可以改为自己针对的对象文件
- For i = 1 To 5000
- fs.Write Int(Rnd* 10000+1) & VbCrlf
- Next
- fs.Close
- ' 结合Excel进行排序, 回复可见
- Dim xlA,xlB,xlS,xlR,xlT
- Set xlA = CreateObject("Excel.Application")
- Set xlB = xlA.Workbooks.Open("C:\Test.txt") ' "C:\Test.txt" 可以改为自己针对的对象文件
- Set xlS = xlB.Worksheets(1)
- Set xlR = xlS.UsedRange
- Set xlT = xlA.Range("A1")
- xlR.Sort(xlT)
- xlB.Save
- xlB.Close
- 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
|