注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

张思思廊坊师范学院信息技术提高班 十一期

改变需要不断去做。。。

 
 
 

日志

 
 

【转载】VB排序算法  

2014-02-13 17:41:59|  分类: 技术技能 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
本文转载自姚朝霞《VB排序算法》

一、直接插入排序法

排序算法 - 姚朝霞 - 姚朝霞廊坊师范学院信息技术提高班 十一期
 Option Explicit

Private 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
二、选择排序法
VB排序算法 - 姚朝霞 - 姚朝霞廊坊师范学院信息技术提高班 十一期
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
三、希尔排序
VB排序算法 - 姚朝霞 - 姚朝霞廊坊师范学院信息技术提高班 十一期
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
四、起泡排序法
VB排序算法 - 姚朝霞 - 姚朝霞廊坊师范学院信息技术提高班 十一期
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 五、快速排序法
VB排序算法 - 姚朝霞 - 姚朝霞廊坊师范学院信息技术提高班 十一期
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
六、归并排序法
VB排序算法 - 姚朝霞 - 姚朝霞廊坊师范学院信息技术提高班 十一期
 
VB排序算法 - 姚朝霞 - 姚朝霞廊坊师范学院信息技术提高班 十一期
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 i
End Sub
 

 
 

  


  评论这张
 
阅读(13)| 评论(9)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017