| 
                                        
                                     
                                        
                                        超级版主122889427060258236 朵36314 个4931 个4213402012-07-18 | 
                                        
                                            
                                                
                                                1#
                                                
                                            
                                        
                                        
                                            
                                                
                                                
                                                t
                                                T
                                            发表于 2022-03-20 23:17
                                            
                                                                                        
                                            | 
                                            
                                            
                                            |只看楼主 
                    
                    
                    
                   
                    
                        
                        
                        最常用的排序1[冒泡排序]:最常用的排序2[冒泡排序]:(其实对比并不限于数字)复制代码字符串 = "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(变量,",")
复制代码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  |