网上搜到的vb二维数组排序程序,但有些问题,1、数组的第1列如何排序,列不能指定为0,2、最后一列没有排序,请帮组修改程序。谢谢! Private Sub Command1_Click() 'Sub Command1_Click() '这里不妨用10000个元素, '事实上在窗体打出的第一个数字时,排序就已经完成了!!. '可以不用再考虑排序的效率了 Dim myAy(10000, 10) As Long Dim i As Long Dim j As Long '进行随机的给数组赋值 For i = 0 To UBound(myAy, 1) For j = 0 To UBound(myAy, 2) myAy(i, j) = Fix(10000 * Rnd) Next Next '输入到窗口 Sheet1.Cells(1, 1).Resize(UBound(myAy, 1), UBound(myAy, 2)) = myAy Dim cl As Long cl = Val(InputBox("请输入要排序的列 1~10")) 'Cls dSort myAy, cl Sheet2.Cells(1, 1).Resize(UBound(myAy, 1), UBound(myAy, 2)) = myAy 'Print 'Print Tab(cl * 10); "第" & cl; "列排序" 'Print 'For i = 0 To UBound(myAy, 1) ' For j = 0 To UBound(myAy, 2) ' Print Tab(j * 10); myAy(i, j); ' Next ' Print 'Next End Sub '************************************************ '升序快速排序法 'Sub QkSort() Sub QkSort(Ay() As Long, Io As Long, Jo As Long, index() As Long) 'Ay()只能传入一维数组 'index()传入一维数组,注意:数组上标一定要和AY()一样 Dim i As Long, j As Long, X As Long, tp As Long Dim bQ As Boolean 'i到j跳跃开关 '初始化 i = Io j = Jo X = Ay(i) '一轮排序 Do While i < j If Not bQ Then If Ay(j) < X Then tp = Ay(j): Ay(j) = Ay(i): Ay(i) = tp tp = index(j): index(j) = index(i): index(i) = tp bQ = True Else j = j - 1 End If Else If Ay(i) > X Then tp = Ay(j): Ay(j) = Ay(i): Ay(i) = tp tp = index(j): index(j) = index(i): index(i) = tp bQ = False Else i = i + 1 End If End If Loop '递归 If i < Jo Then QkSort Ay, j + 1, Jo, index '注意靠后的要加1 If Io < j Then QkSort Ay, Io, i, index End Sub '二维数组排序子程序 'Sub dSort() Sub dSort(a() As Long, ByVal keyCol As Integer) '''''''''''''''''''''''''''''''''' 'dSort子程序 'a()数组,只能传入二维数组 'keycol参数是要排序的列 '''''''''''''''''''''''''''''''''''' Dim Row As Long Dim Col As Long Dim idx() As Long '存放需要排序的列 Dim index() As Long '存放一个索引.方便操作其他非排序列 Dim i As Long Dim j As Long Dim temp As Long Dim b() As Long '一个过渡的二维数组. '初始化 Row = UBound(a, 1) Col = UBound(a, 2) ReDim b(Row, Col) ReDim idx(Row) ReDim index(Row) '初始化排序的列的数组,及索引数组 For i = 0 To Row idx(i) = a(i, keyCol) index(i) = i Next '根据排列的数组对索引列排序 '使用快速排序法 QkSort idx, 0, Row, index '整个二维数组,根据索引进行排序. For j = 0 To Col For i = 0 To Row b(i, j) = a(index(i), j) Next Next For i = 0 To Row For j = 0 To Col a(i, j) = b(i, j) Next Next End Sub
|