只用一个 Sub ,通用于数字、字符串，升序、降序，不同的边界条件。高效运算：没有元素交换，至多搜索半数的已排元素，就能将新元素插值到准确的位置上。
Option Explicit
Dim Si(10) As Single, St(3 To 12) As String
Private Sub Form_Load()
Me.AutoRedraw = True
Command1.Caption = "原始数据"
Command2.Caption = ""
Command2.Enabled = False
End Sub
Private Sub Command1_Click()
Dim pp As Integer, rr As Integer
Cls
Si(0) = ((Timer * 100) Mod 1673) / 10
St(3) = CStr(Si(0)) & Right$(CStr(Si(0)), 2)
For pp = 1 To 10
Si(pp) = Rnd(Si(pp - 1) - Si(0)) * 40
If InStr(1, Str(Si(pp)), "E") > 0 Then
If pp > 1 Then
Si(pp) = Si(pp - 2) '数值相等
Else
Si(pp) = -Si(pp - 1) '负值
End If
End If
If pp < 10 Then
St(pp + 3) = Trim(Right$(Str(Si(pp)), 6))
rr = InStr(1, St(pp + 3), ".")
If rr > 0 And pp Mod 2 = 1 Then
St(pp + 3) = Trim(Mid$(St(pp + 3), rr + 1))
End If
End If
Next pp
Print " 数字", " 字符串"
For pp = 0 To 10
Print Si(pp),
If pp < 10 Then Print St(pp + 3)
Next pp
If Fix(Si(0)) Mod 2 = 1 Then
Command2.Caption = "数字排序"
Else
Command2.Caption = "字符排序"
End If
Command2.Enabled = True
End Sub
Private Sub Sort(X1, Up As Boolean)
Dim pp, rr, ss, Lb As Integer
Dim Va As New Collection '相当于 Va() As Variant
Lb = LBound(X1)
rr = UBound(X1) - Lb
Va.Add X1(Lb) '添加第一个元素
For pp = 1 To rr
If (X1(Lb + pp) <= Va(1) And Up = True) Or _
(X1(Lb + pp) >= Va(1) And Up = False) Then
Va.Add X1(Lb + pp), BEFORE:=1 '放最前面
ElseIf (X1(Lb + pp) >= Va(pp) And Up = True) Or _
(X1(Lb + pp) <= Va(pp) And Up = False) Then
Va.Add X1(Lb + pp) '追加在最后
Else '非极值则插值到合适处
ss = 1 + (pp - 1) \ 2 '从中间开始
Do
If (Up = True And Va(ss) <= X1(Lb + pp) And Va(ss + 1) >= X1(Lb + pp)) Or _
(Up = False And Va(ss) >= X1(Lb + pp) And Va(ss + 1) <= X1(Lb + pp)) Then
Va.Add X1(Lb + pp), AFTER:=ss '插值到ss后
Exit Do
ElseIf (Up = True And Va(ss) >= X1(Lb + pp) And Va(ss - 1) <= X1(Lb + pp)) Or _
(ss > 1 And Up = False And Va(ss) <= X1(Lb + pp) And Va(ss - 1) >= X1(Lb + pp)) Then
Va.Add X1(Lb + pp), BEFORE:=ss '插值到ss前
Exit Do
ElseIf (Up = True And Va(ss) < X1(Lb + pp)) Or _
(Up = False And Va(ss) > X1(Lb + pp)) Then
ss = ss + 1 '向后移一位
Else
ss = ss - 1 '向前移一位
End If
Loop
End If
Next pp '下面内容会改原数组
For pp = 0 To Va.Count - 1
X1(Lb + pp) = Va(pp + 1)
Next pp
End Sub
Private Sub Command2_Click()
Dim pp As Integer, tt As Boolean
Form1.CurrentX = 3300
Form1.CurrentY = 0
tt = Si(8) > Si(3) '升降序也是随机的
If tt = True Then
Print " 升排序"
Else
Print " 降排序"
End If
If Command2.Caption = "数字排序" Then
Call Sort(Si, tt)
For pp = 0 To 10
Form1.CurrentX = 3300
Print Si(pp)
Next pp
Else
Call Sort(St, tt)
For pp = 3 To 12
Form1.CurrentX = 3300
Print St(pp)
Next pp
End If
Command2.Enabled = False
End Sub

用Collection做排序,应该是比交换元素慢的.