笔者在学习vb中发现利用集合可以进行排序，优化后比冒泡法快得多。下面是完整的函数代码，演示了如何进行数组的升序或降序排列。
option explicit
dim x(100) as double
dim y(100) as string
private sub command1_click() '演示数字排序
dim a(100) as double, z(100) as string, i as long
for i = 0 to 100
a(i) = x(i) '复制数组
z(i) = cstr(x(i)) '转化为字符串数组
next
msgbox join(z, ","), 64, "原始数组" '显示原始顺序
numbersort x, "up"
for i = 0 to 100
z(i) = cstr(x(i)) '转化为字符串数组
next
msgbox join(z, ","), 64, "按数字升序排序后数组" '显示排序结果
numbersort a, "down"
for i = 0 to 100
z(i) = cstr(a(i)) '转化为字符串数组
next
msgbox join(z, ","), 64, "按数字降序排序后数组" '显示排序结果
end sub
sub numbersort(byref a() as double, optional sort as string = "up") '数字排序
dim min as long, max as long, num as long, first as long, last as long, temp as long, 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
last = all.count
if a(num) < cdbl(all(1)) then all.add a(num), before:=1: goto nextnum '加到第一项
if a(num) > cdbl(all(last)) then all.add a(num), after:=last: goto nextnum '加到最后一项
first = 1
do while last > first + 1 '利用do循环减少循环次数
temp = (last + first) \ 2
if a(num) > cdbl(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
if sort = "up" or sort = "up" then a(num) = cdbl(all(num - min + 1)): steps = steps + 1 '升序
if sort = "down" or sort = "down" then a(num) = cdbl(all(max - num + 1)): steps = steps + 1 '降序
next
msgbox "本数组共经过 " & steps & "步实现" & iif(sort = "up" or sort = "up", "升序", "降序") & "排序！", 64, "information"
set all = nothing
end sub
sub stringsort(byref a() as string, optional sort as string = "up") '字符串排序
dim min as long, max as long, num as long, first as long, last as long, temp as long, 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 '利用do循环减少循环次数
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
if sort = "up" or sort = "up" then a(num) = all(num - min + 1): steps = steps + 1 '升序
if sort = "down" or sort = "down" then a(num) = all(max - num + 1): steps = steps + 1 '降序
next
msgbox "本数组共经过 " & steps & "步实现" & iif(sort = "up" or sort = "up", "升序", "降序") & "排序！", 64, "information"
set all = nothing
end sub
private sub command2_click() '演示字符串排序
dim z(100) as string, i as long '复制数组
for i = 0 to 100
z(i) = y(i)
next
msgbox join(y, ","), 64, "原始数组" '显示原始顺序
stringsort y, "up"
msgbox join(y, ","), 64, "按字符串升序排序后数组" '显示排序结果
stringsort z, "down"
msgbox join(z, ","), 64, "按字符串降序排序后数组" '显示排序结果
end sub
private sub command3_click() ' 排序计时
dim a(3000) as string, i as long, starttime as long, endtime as long
for i = 0 to 3000
a(i) = chr(int(rnd * 26) + 65) & chr(int(rnd * 26) + 65) & chr(int(rnd * 26) + 65) & chr(int(rnd * 26) + 65) & chr(int(rnd * 26) + 65) & chr(int(rnd * 26) + 65) '生成随机6字符的字符串
next
starttime = timer '计时开始
stringsort a
endtime = timer '计时结束
msgbox "排序共耗时 " & endtime - starttime & " 秒！"
end sub
private sub form_load()
randomize
dim i as long
for i = 0 to 100
x(i) = format(rnd * 1000, "0.00")
y(i) = chr(int(rnd * 26) + 65) & chr(int(rnd * 26) + 65) & chr(int(rnd * 26) + 65)
next
end sub
