一、直接插入排序法
Option ExplicitPrivate Sub sort() Dim i, j, h, t As Integer Dim r() As String Dim k As String r() = Split(Text1.Text, ".") Text2.Text = Text2.Text & "[初始关键字]" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next t Text2.Text = Text2.Text & vbCrLf & vbCrLf For i = 0 To UBound(r) - 1 For j = 0 To UBound(r) - i - 1 If Val(r(j)) > Val(r(j + 1)) Then k = r(j) r(j) = r(j + 1) r(j + 1) = k End If Next j Text2.Text = Text2.Text & i + 1 & "趟排序结果" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next
Text2.Text = Text2.Text & vbCrLf
Next i
End Sub
Private Sub Command1_Click()
Call sort
End Sub
二、选择排序法
Option Explicit Dim i, j, k, t As Integer Dim r() As String Dim prvotkey As String Private Sub SelectSort(r() As String) Text2.Text = Text2.Text & "[初始关键字]" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next t Text2.Text = Text2.Text & vbCrLf & vbCrLf For i = LBound(r) To UBound(r) k = i For j = i + 1 To UBound(r) If Val(r(j)) < Val(r(k)) Then k = j End If Next j If k <> i Then prvotkey = r(i) r(i) = r(k) r(k) = prvotkey End If Text2.Text = Text2.Text & i + 1 & "趟排序结果:" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next t Text2.Text = Text2.Text & vbCrLf Next i End Sub Private Sub Command1_Click() r() = Split(Text1.Text, ".") Call SelectSort(r()) End Sub三、希尔排序Option Explicit Private Sub Command1_Click() Call ShellSort End Sub Private Sub ShellSort() Dim i, j, h, t, count As Integer Dim r() As String Dim k As String r() = Split(Text1.Text, ".") Do While UBound(r) / 3 > h h = h * 3 + 1 Loop Do While h > 0 For i = h To UBound(r) k = r(i) j = i Do While j > h - 1 And Val(r(j - h)) > k r(j) = r(j - h) j = j - h If j - h < 0 Then Exit Do End If Loop r(j) = k Next i h = (h - 1) / 3 count = count + 1 Text2.Text = Text2.Text & count & "趟排序结果:" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next t Text2.Text = Text2.Text & vbCrLf Loop End Sub四、起泡排序法Option Explicit Private Sub b() Dim i, j, t As Integer Dim r() As String Dim k As String r() = Split(Text1.Text, ".") Text2.Text = Text2.Text & "[初始关键字]" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next t Text2.Text = Text2.Text & vbCrLf & vbCrLf For i = 0 To UBound(r) - 1 For j = 0 To UBound(r) - i - 1 If Val(r(j)) > Val(r(j + 1)) Then k = r(j) r(j) = r(j + 1) r(j + 1) = k End If Next j Text2.Text = Text2.Text & i + 1 & "趟排序结果:" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next t Text2.Text = Text2.Text & vbCrLf Next i End Sub Private Sub Command1_Click() Call b End Sub 五、快速排序法Option Explicit Dim i, j, k, low, high, t As Integer Dim r() As String Dim a As Integer Dim b As String Private Function p(r() As String, low As Integer, hight As Integer) As Integer i = low j = high b = r(low) Do While low < high Do While low < high And Val(r(hight)) >= Val(b) high = high - 1 Loop r(low) = r(high) Do While low < high And Val(r(low)) <= Val(b) low = low + 1 Loop r(high) = r(low) Loop r(low) = b p = low low = i high = j k = k + 1 Text2.Text = Text2.Text & k & "次分划结果:" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next t Text2.Text = Text2.Text & vbCrLf End Function Private Sub q(r() As String, low As Integer, high As Integer) i = low j = high If (low < high) Then a = p(r(), low, high) Call q(r, low, a - 1) Call q(r, a + 1, high) End If End Sub Private Sub Command1_Click() k = 0 r() = Split(Text1.Text, ".") Text2.Text = Text2.Text & "初始关键字" For t = 0 To UBound(r) Text2.Text = Text2.Text & r(t) & " " Next t Text2.Text = Text2.Text & vbCrLf & vbCrLf Call q(r, LBound(r), UBound(r)) End Sub六、归并排序法Option Explicit Private Sub merge(r, s, ByVal x1 As Integer, ByVal x2 As Integer, ByVal x3 As Integer) Dim i As Integer, j As Integer, k As Integer i = x1 j = x2 + 1 k = x1 Do While i <= x2 And j <= x3 If r(i) < r(j) Then s(k) = r(i) i = i + 1 k = k + 1 Else s(k) = r(j) j = j + 1 k = k + 1 End If Loop Do While i <= x2 s(k) = r(i) i = i + 1 k = k + 1 Loop Do While j <= x3 s(k) = r(j) j = j + 1 k = k + 1 Loop End Sub Private Sub merge_sort(r, s, ByVal m As Integer, ByVal n As Integer) Dim p As Integer Dim t(19) As Integer If m = n Then s(m) = r(m) Else p = (m + n) \ 2 merge_sort r, t, m, p merge_sort r, t, p + 1, n merge t, s, m, p, n End If End Sub Private Sub Form_Activate() Me.Cls Dim a(10) As Integer Dim i As Integer MsgBox "请输入10个数" Print "排序前:"; For i = 1 To 10 a(i) = Val(InputBox("第" & i & "个数")) Print a(i); Next i Print Print merge_sort a, a, 1, 10 Print "排序后"; For i = 1 To 10 Print a(i); Next iEnd Sub
评论