Option Explicit
Private Sub Command1_Click()
Dim a As Integer, b As Integer, c As Integer
a = Text1.Text
b = Text2.Text
c = Text3.Text
d = Text4.Text
If a > b Then
If b > c Then
d = "a>b>c"
Else
If a > c Then
d = "a>c>b"
Else
d = "c>a>b"
End If
End If
If a > c Then
d = "b>a>c"
Else
If b > c Then
d = "b>c>a"
Else
d = "c>b>a"
End If
End If
End If
End Sub
uj5u.com熱心網友回復：
d似乎沒有給到定義呢uj5u.com熱心網友回復：
我這還是第一次自己弄
，d該怎么定義啊？
uj5u.com熱心網友回復：
而且邏輯有些問題吧，前面兩個end if只結束了b>c和a>c的判斷，最開始的a>b沒有結束判斷呢uj5u.com熱心網友回復：
并且還有可能存在相等的情況，這個也需要考慮下呢uj5u.com熱心網友回復：
dim d as string
uj5u.com熱心網友回復：
好的，謝謝大佬解惑，麻煩你啦??uj5u.com熱心網友回復：
數字、字串排序不是應該用點陣列呀、冒泡法之類的回圈處理進行排序的嗎？這么事情會變成這樣
uj5u.com熱心網友回復：
你的代碼用字串直接比較，那么 "2" > "18"絕對不是你想要的
uj5u.com熱心網友回復：
你這種排序 復雜 而且 資料越多 代碼量越大 最好不要用我給你一套
'======================================================各種排列法
'API
Option Explicit
Global Const ZERO = 0
Global Const ASCENDING_ORDER = 0
Global Const DESCENDING_ORDER = 1
Global gIterations
Sub BubbleSort(MyArray(), ByVal nOrder As Integer)
Dim Index
Dim TEMP
Dim NextElement
NextElement = ZERO
Do While (NextElement < UBound(MyArray))
Index = UBound(MyArray)
Do While (Index > NextElement)
If nOrder = ASCENDING_ORDER Then
If MyArray(Index) < MyArray(Index - 1) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - 1)
MyArray(Index - 1) = TEMP
End If
ElseIf nOrder = DESCENDING_ORDER Then
If MyArray(Index) >= MyArray(Index - 1) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - 1)
MyArray(Index - 1) = TEMP
End If
End If
Index = Index - 1
gIterations = gIterations + 1
Loop
NextElement = NextElement + 1
gIterations = gIterations + 1
Loop
End Sub
Sub Bucket(MyArray(), ByVal nOrder As Integer)
Dim Index
Dim NextElement
Dim TheBucket
NextElement = LBound(MyArray) + 1
While (NextElement <= UBound(MyArray))
TheBucket = MyArray(NextElement)
Index = NextElement
Do
If Index > LBound(MyArray) Then
If nOrder = ASCENDING_ORDER Then
If TheBucket < MyArray(Index - 1) Then
MyArray(Index) = MyArray(Index - 1)
Index = Index - 1
Else
Exit Do
End If
ElseIf nOrder = DESCENDING_ORDER Then
If TheBucket >= MyArray(Index - 1) Then
MyArray(Index) = MyArray(Index - 1)
Index = Index - 1
Else
Exit Do
End If
End If
Else
Exit Do
End If
gIterations = gIterations + 1
Loop
MyArray(Index) = TheBucket
NextElement = NextElement + 1
gIterations = gIterations + 1
Wend
End Sub
Sub Heap(MyArray())
Dim Index
Dim Size
Dim TEMP
Size = UBound(MyArray)
Index = 1
While (Index <= Size)
Call HeapSiftup(MyArray(), Index)
Index = Index + 1
gIterations = gIterations + 1
Wend
Index = Size
While (Index > 0)
TEMP = MyArray(0)
MyArray(0) = MyArray(Index)
MyArray(Index) = TEMP
Call HeapSiftdown(MyArray(), Index - 1)
Index = Index - 1
gIterations = gIterations + 1
Wend
End Sub
Sub HeapSiftdown(MyArray(), M)
Dim Index
Dim Parent
Dim TEMP
Index = 0
Parent = 2 * Index
Do While (Parent <= M)
If (Parent < M And MyArray(Parent) < MyArray(Parent + 1)) Then
Parent = Parent + 1
End If
If MyArray(Index) >= MyArray(Parent) Then
Exit Do
End If
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Parent)
MyArray(Parent) = TEMP
Index = Parent
Parent = 2 * Index
gIterations = gIterations + 1
Loop
End Sub
Sub HeapSiftup(MyArray(), M)
Dim Index
Dim Parent
Dim TEMP
Index = M
Do While (Index > 0)
Parent = Int(Index / 2)
If MyArray(Parent) >= MyArray(Index) Then
Exit Do
End If
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Parent)
MyArray(Parent) = TEMP
Index = Parent
gIterations = gIterations + 1
Loop
End Sub
Sub Insertion(MyArray(), ByVal nOrder As Integer)
Dim Index
Dim TEMP
Dim NextElement
NextElement = LBound(MyArray) + 1
While (NextElement <= UBound(MyArray))
Index = NextElement
Do
If Index > LBound(MyArray) Then
If nOrder = ASCENDING_ORDER Then
If MyArray(Index) < MyArray(Index - 1) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - 1)
MyArray(Index - 1) = TEMP
Index = Index - 1
Else
Exit Do
End If
ElseIf nOrder = DESCENDING_ORDER Then
If MyArray(Index) >= MyArray(Index - 1) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - 1)
MyArray(Index - 1) = TEMP
Index = Index - 1
Else
Exit Do
End If
End If
Else
Exit Do
End If
gIterations = gIterations + 1
Loop
NextElement = NextElement + 1
gIterations = gIterations + 1
Wend
End Sub
Sub QuickSort(MyArray(), L, R)
Dim I, J, X, Y
I = L
J = R
X = MyArray((L + R) / 2)
While (I <= J)
While (MyArray(I) < X And I < R)
I = I + 1
Wend
While (X < MyArray(J) And J > L)
J = J - 1
Wend
If (I <= J) Then
Y = MyArray(I)
MyArray(I) = MyArray(J)
MyArray(J) = Y
I = I + 1
J = J - 1
End If
gIterations = gIterations + 1
Wend
If (L < J) Then Call QuickSort(MyArray(), L, J)
If (I < R) Then Call QuickSort(MyArray(), I, R)
End Sub
Sub Selection(MyArray(), ByVal nOrder As Integer)
Dim Index
Dim Min
Dim NextElement
Dim TEMP
NextElement = 0
While (NextElement < UBound(MyArray))
Min = UBound(MyArray)
Index = Min - 1
While (Index >= NextElement)
If nOrder = ASCENDING_ORDER Then
If MyArray(Index) < MyArray(Min) Then
Min = Index
End If
ElseIf nOrder = DESCENDING_ORDER Then
If MyArray(Index) >= MyArray(Min) Then
Min = Index
End If
End If
Index = Index - 1
gIterations = gIterations + 1
Wend
TEMP = MyArray(Min)
MyArray(Min) = MyArray(NextElement)
MyArray(NextElement) = TEMP
NextElement = NextElement + 1
gIterations = gIterations - 1
Wend
End Sub
Sub ShellSort(MyArray(), ByVal nOrder As Integer)
Dim Distance
Dim Size
Dim Index
Dim NextElement
Dim TEMP
Size = UBound(MyArray) - LBound(MyArray) + 1
Distance = 1
While (Distance <= Size)
Distance = 2 * Distance
Wend
Distance = (Distance / 2) - 1
While (Distance > 0)
NextElement = LBound(MyArray) + Distance
While (NextElement <= UBound(MyArray))
Index = NextElement
Do
If Index >= (LBound(MyArray) + Distance) Then
If nOrder = ASCENDING_ORDER Then
If MyArray(Index) < MyArray(Index - Distance) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - Distance)
MyArray(Index - Distance) = TEMP
Index = Index - Distance
gIterations = gIterations + 1
Else
Exit Do
End If
ElseIf nOrder = DESCENDING_ORDER Then
If MyArray(Index) >= MyArray(Index - Distance) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - Distance)
MyArray(Index - Distance) = TEMP
Index = Index - Distance
gIterations = gIterations + 1
Else
Exit Do
End If
End If
Else
Exit Do
End If
Loop
NextElement = NextElement + 1
gIterations = gIterations + 1
Wend
Distance = (Distance - 1) / 2
gIterations = gIterations + 1
Wend
End Sub
'--------------------------------------------------代碼
ReDim mArray(0 To 100)
Rand=亂數
mArray(I) = Rand
'------------------------------------------------------排列方法(最后的0是代表升序法)
Call BubbleSort(mArray(), 0) '冒泡排序法
Call Insertion(mArray(), 0) '插入排序法
Call Bucket(mArray(), 0) 'Bucket排序法
Call Selection(mArray(), 0) '選擇排序法
Call ShellSort(mArray(), 0) 'Shell排序法
Call QuickSort(mArray(), 0, UBound(mArray)) '快速排列法
Call Heap(mArray()) 'Heap排序法
'-----------------------------------------------------
For I = 0 To UBound(mArray)
List1.AddItem mArray(I)
Next
‘==========================或者 另一種排序
'================================================陣列排列組合
Dim mstr As String
Private Sub Command1_Click()
List1.Clear
mstr = InputBox("請隨便輸入4個字符：", "", "11452")
Dim all As String
all = showall(Len(mstr), mstr)
Dim i As Integer
Dim j As Integer
End Sub
Private Function showall(N As Integer, sum1 As String) As String
showall = ArrayP(Space(N - 1), Left(sum1, N))
End Function
Private Function ArrayP(ByVal BaseStr As String, ByVal LeftStr As String) As String
Dim i&, PNow&, j&
If Len(LeftStr) = 1 Then
ArrayP = BaseStr & LeftStr
For j = 0 To List1.ListCount
If List1.List(j) = ArrayP Then
Exit Function
End If
Next
List1.AddItem ArrayP
Exit Function
End If
PNow = Len(BaseStr) - Len(LeftStr) + 2
For i = 1 To Len(LeftStr)
Mid(BaseSt
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/36999.html
標籤：VB基礎類
上一篇：求大佬看一下哪錯了