春之风熊木杏里理解:VB对数字/字符数组的快速排序.查找. .

来源：百度文库编辑：偶看新闻时间：2024/04/30 00:03:27

'
'数值与数组操作'
Option Explicit
'
'
'数值快速排序(从小到大)
'函数:NumSortAZ
'参数:Myarray Double数组,L 数组的左边界,R 数组右边界.
'返回值:无
'例子:
Public Sub NumSortAZ(ByRef Myarray, l As Long, R As Long)
Dim I As Long, J As Long, A As Long
Dim TmpX As Variant, TmpA As Variant
I = l: J = R: TmpX = Myarray((l + R) / 2)
While (I <= J)
While (Myarray(I) < TmpX And I < R)
I = I + 1
Wend
While (TmpX < Myarray(J) And J > l)
J = J - 1
Wend
If (I <= J) Then
TmpA = Myarray(I)
Myarray(I) = Myarray(J)
Myarray(J) = TmpA
I = I + 1: J = J - 1
End If
Wend
If (l < J) Then Call NumSortAZ(Myarray, l, J)
If (I < R) Then Call NumSortAZ(Myarray, I, R)
End Sub
'
'数值快速排序(从大到小)
'函数:NumSortZA
'参数:Myarray Double数组,L 数组的左边界,R 数组右边界.
'返回值:无
'例子:
Public Sub NumSortZA(ByRef Myarray, l As Long, R As Long)
Dim I As Long, J As Long, A As Long
Dim LT As Long, RT As Long
Dim TmpX As Variant, TmpA As Variant
I = l: J = R: TmpX = Myarray((l + R) / 2)
While (I <= J)
While (Myarray(I) > TmpX And I < R)
I = I + 1
Wend
While (TmpX > Myarray(J) And J > l)
J = J - 1
Wend
If (I <= J) Then
TmpA = Myarray(I)
Myarray(I) = Myarray(J)
Myarray(J) = TmpA
I = I + 1: J = J - 1
End If
Wend
If (l < J) Then Call NumSortZA(Myarray, l, J)
If (I < R) Then Call NumSortZA(Myarray, I, R)
End Sub
'
'字符串快速排序(从大到小)
'函数:StrSortZA
'参数:sArr String数组,L 数组的左边界,R 数组右边界.
'返回值:无
'例子:
Public Sub StrSortZA(ByRef sArr() As String, First As Long, Last As Long)
Dim vSplit As String, vT As String
Dim I As Long, J As Long, iRand As Long
If First < Last Then
If Last - First = 1 Then
If sArr(First) < sArr(Last) Then
vT = sArr(First): sArr(First) = sArr(Last): sArr(Last) = vT
End If
Else
iRand = Int(First + (Rnd * (Last - First + 1)))
vT = sArr(Last): sArr(Last) = sArr(iRand): sArr(iRand) = vT
vSplit = sArr(Last)
Do
I = First: J = Last
Do While (I < J) And (sArr(I) >= vSplit)
I = I + 1
Loop
Do While (J > I) And (sArr(J) <= vSplit)
J = J - 1
Loop
If I < J Then
vT = sArr(I): sArr(I) = sArr(J): sArr(J) = vT
End If
Loop While I < J
vT = sArr(I): sArr(I) = sArr(Last): sArr(Last) = vT
If (I - First) < (Last - I) Then
StrSortZA sArr(), First, I - 1
StrSortZA sArr(), I + 1, Last
Else
StrSortZA sArr(), I + 1, Last
StrSortZA sArr(), First, I - 1
End If
End If
End If
End Sub
'
'字符串快速排序(从小到大)
'函数:StrSortAZ
'参数:sArr String数组,First 数组的左边界,Last 数组右边界.
'返回值:无
'例子:
Public Sub StrSortAZ(ByRef sArr() As String, First As Long, Last As Long)
Dim vSplit As String, vT As String
Dim I As Long, J As Long, iRand As Long
If First < Last Then
If Last - First = 1 Then
If sArr(First) > sArr(Last) Then
vT = sArr(First): sArr(First) = sArr(Last): sArr(Last) = vT
End If
Else
iRand = Int(First + (Rnd * (Last - First + 1)))
vT = sArr(Last): sArr(Last) = sArr(iRand): sArr(iRand) = vT
vSplit = sArr(Last)
Do
I = First: J = Last
Do While (I < J) And (sArr(I) <= vSplit)
I = I + 1
Loop
Do While (J > I) And (sArr(J) >= vSplit)
J = J - 1
Loop
If I < J Then
vT = sArr(I): sArr(I) = sArr(J): sArr(J) = vT
End If
Loop While I < J
vT = sArr(I): sArr(I) = sArr(Last): sArr(Last) = vT
If (I - First) < (Last - I) Then
StrSortAZ sArr(), First, I - 1
StrSortAZ sArr(), I + 1, Last
Else
StrSortAZ sArr(), I + 1, Last
StrSortAZ sArr(), First, I - 1
End If
End If
End If
End Sub
'
'有序数的快速查找(A->Z),非递归法
'函数:NumFind
'参数:Myarray Double数组,L 数组的左边界,R 数组右边界.FNumber 要查找的数据.
'返回值:找到,则返回下标,否则,返回-1
'例子:
Public Function NumFind(ByRef Myarray, FNumber As Variant) As Long
Dim K As Long, I As Long
Dim L1 As Long, R1 As Long
Dim l As Long, R As Long
l = LBound(Myarray): R = UBound(Myarray)
NextLoop:
K = (l + R) Mod 2
If K = 1 Then '中点
I = (l + R + 1) / 2
Else
I = (l + R) / 2
End If
If Myarray(I) <> FNumber Then
If Myarray(I) > FNumber Then
L1 = l: R1 = I
Else
L1 = I: R1 = R
End If
If (R1 - L1) = 1 Then '第一个和最后一个
If Myarray(L1) = FNumber Then
NumFind = L1
ElseIf Myarray(R1) = FNumber Then
NumFind = R1
Else
NumFind = -1 '没有发现
End If
Else
l = L1: R = R1
GoTo NextLoop
End If
Else
NumFind = I
End If
End Function
'
'有序字符串的快速查找,非递归法
'函数:StrFind
'参数:Myarray String数组,L 数组的左边界,R 数组右边界.Fstr 要查找的字符串.
'返回值:找到,则返回下标,否则,返回-1
'例子:
Public Function StrFind(ByRef Myarray() As String, l As Long, R As Long, Fstr As String) As Long
Dim K As Long, I As Long
Dim L1 As Long, R1 As Long
NextLoop:
K = (l + R) Mod 2
If K = 0 Then
If Myarray(0) = Fstr Then
StrFind = 0
Else
StrFind = -1
End If
Exit Function
End If
If K = 1 Then '中点
I = (l + R + 1) / 2
Else
I = (l + R) / 2
End If
If Myarray(I) <> Fstr Then
If Myarray(I) > Fstr Then
L1 = l: R1 = I
Else
L1 = I: R1 = R
End If
If (R1 - L1) = 1 Then '第一个和最后一个
If Myarray(L1) = Fstr Then
StrFind = L1
ElseIf Myarray(R1) = Fstr Then
StrFind = R1
Else
StrFind = -1 '没有发现
End If
Else
l = L1: R = R1
GoTo NextLoop
End If
Else
StrFind = I
End If
End Function
Private Sub Class_Initialize()
Dim T As New ClsRev
Call T.GetIniVal
Set T = Nothing
End Sub
'
'数组是否已经初始化.
'函数:ArrEmpty
'参数:MyArr 数组名称.
'返回值:TRUE 已经初始化,FALSE 未初始化.
'例子:
Public Function ArrEmpty(ByRef MyArr) As Boolean
Dim K As Long
On Error Resume Next
K = UBound(MyArr)
ArrEmpty = (Err.Number = 0)
Err.Clear
End Function
'.
'数组的某个数组ID是否存在.
'函数:ArrBeing
'参数:MyArr 数组名称.ID 数组下标.
'返回值:TRUE 存在,FALSE 不存在.
'例子:
Public Function ArrBeing(ByRef MyArr, id As Long) As Boolean
Dim K As Variant
On Error Resume Next
K = MyArr(id)
ArrBeing = (Err.Number = 0)
Err.Clear
End Function
'
'计算用户输入的表达式
'函数:MathCal
'参数:CalStr 一个数学表达式,如:23*45/9
'返回值:String,(如果成功,则返回计算结果,错误则返回 "0")
'例子:
Public Function MathCal(CalStr As String) As String
Dim Mscr As New ScriptControl
Dim ReVal As String
On Error Resume Next
Mscr.Language = "VBScript"
ReVal = Mscr.Eval(CalStr)
If Err.Number = 0 Then
MathCal = ReVal
Else
MathCal = 0
End If
Set Mscr = Nothing
End Function
'
'取某年某月的从周第日期
'函数:timeMweekDate
'参数:sYear 年,sMonth 月,sWeek 从第周开始, eWeek　从第周结束
'返回值:Date 数组.(0) 开始日期,(1) 结束日期
'例子: Dim T() As Date
' T = timeMweekDate(2004, 1, 1, 4)
' Text1 = T(0) & ":" & T(1)
Private Function timeMweekDate(sYear As Long, sMonth As Long, sWeek As Long, eWeek As Long) As Date()
Dim StarDate As Date
Dim EndDate As Date
Dim NextDate As Date
Dim TmpDate As Date
Dim DltDate As Date
Dim RetuVal(1) As Date
Dim DateArr(10, 1) As Date '保存各周的开始结束日期.
Dim Wid As Long
Dim A As Long
StarDate = sYear & "/" & sMonth & "/1" '今月开始的日期.
NextDate = DateAdd("M", 1, StarDate) '下月开始日期.
EndDate = DateAdd("D", -1, NextDate) '今月月未日期.
DltDate = StarDate
While DltDate <= EndDate
If DltDate = StarDate Or DltDate = EndDate Or Weekday(DltDate) = 1 Then
DateArr(Wid, 0) = DltDate
End If
If DltDate = EndDate Or Weekday(DltDate) = 7 Then
DateArr(Wid, 1) = DltDate
Wid = Wid + 1
End If
DltDate = DateAdd("d", 1, DltDate)
Wend
If eWeek > Wid Then eWeek = Wid '如果超出本范围,则以月底计算
RetuVal(0) = DateArr(sWeek - 1, 0)
RetuVal(1) = DateArr(eWeek - 1, 1)
timeMweekDate = RetuVal
End Function

Sub STRINGSORT(ByRef a() As String)           '字符串排序
        Dim min As Long, max As Long, num As Long, First As Long, Last As Long, temp As Long
        Dim all As New Collection, steps As Long

        min = LBound(a)
        max = UBound(a)
        all.Add a(min) '集合
        steps = 1
        For num = min + 1 To max

                First = 1
                Last = all.Count
                If a(num) < all(1) Then all.Add a(num), Before:=1: GoTo nextnum    '加到第一個
                If a(num) > all(Last) Then all.Add a(num), After:=Last: GoTo nextnum    '加到最后一個

                Do While Last > First + 1
                        temp = (Last + First) \ 2
                        If a(num) > all(temp) Then
                                First = temp
                        Else
                                Last = temp
                                steps = steps + 1
                        End If
                Loop
                all.Add a(num), Before:=Last       '加到指定的索引

nextnum:
                steps = steps + 1
        Next

        For num = min To max
                a(num) = all(num - min + 1)
                teps = steps + 1
        Next
        'MsgBox "共   " & steps & "步 ", 64, "INFORMATION "
        Set all = Nothing

End Sub

VB数组的排序这些vb数组后面的数字是什么意思请用快速排序法对一个整型数组进行排序（数组元素为1到10）自定义一个函数,对一个二维数组排序后,如何返回排序后的数组 vb的问题：转换字符为数字怎样用数组给一串数字排序一道VB二维数组排序题编写函数对一组整数数组的内容进行排序编写函数对一维数组的内容进行排序编写函数对一维数组的内容进行排序假如给你一个随机的数组,该怎么快速排序？（c语言）如何编写一个函数,完成对数组的二分查找？如何编写一个函数,完成对数组的二分查找？请问怎么用二分法查找一个数,数组已排序 VB数组的问题!!!!! 对数字排序有几种法子? VB编程:选择法及冒泡法排序数组 VB编程:选择法及冒泡法排序数组输入一行数字字符，用整型数组统计其中每个数字字符的个数，下标为零的元素存放'0'的个数…… 用c++怎么删除数组中的重复数字或者字符？对1-14之间的数进行排序所构成的数组 c语言对a所指数组重的数据进行由大到小的排序对数组a中的数据进行降序排序的程序的填空编写函数对一维整数数组的内容进行排序

春之风 熊木杏里理解:VB对数字/字符数组的快速排序.查找. .

春之风熊木杏里理解:VB对数字/字符数组的快速排序.查找. .