VBA二维数组按第二参数排序
本帖最后由 清风明月10 于 2013-5-13 08:00 编辑'自定义函数
Function 二维数组按第二参数排序(将要排序的数组, 第2参数的第几列如果是一维填1即可, 升序1降序非1) '(将要排序的数组[将要排序的数组], 第2参数的第几列如果是一维填1即可[垂直数组(y,x)中x,像表格中的哪一列], 升序1降序非1[=1,升序;<>1,降序])
'自定义函数中不能有“Application.Transpose”转置函数,否则CAD中不能使用
Dim t, x&, y&, i&, j&, k&
Dim 数组维数 As New 数组排序
AD = 数组维数.判断数组维数(将要排序的数组)
'这个IF是,如果如果是一维就转为二维。如果是二维,则看“第2参数的第几列如果是一维填1即可”该列的序号是否和数组吻合。
If AD = 2 Then
'。如果是二维,则看“第2参数的第几列如果是一维填1即可”该列的序号是否和数组吻合。不吻合就退出自定义函数
If Not (第2参数的第几列如果是一维填1即可 >= LBound(将要排序的数组, 2) And 第2参数的第几列如果是一维填1即可 <= UBound(将要排序的数组, 2)) Then Exit Function
Else
Exit Function
End If
y = LBound(将要排序的数组, 1)
x = LBound(将要排序的数组, 2)
If 升序1降序非1 = 1 Then '升序
For i = y To UBound(将要排序的数组) - 1
For j = i + 1 To UBound(将要排序的数组)
If 将要排序的数组(j, 第2参数的第几列如果是一维填1即可) < 将要排序的数组(i, 第2参数的第几列如果是一维填1即可) Then '冒泡排序法
'这句话是将J行的数据N个与I行的数据N个互换
For k = x To UBound(将要排序的数组, 2)
t = 将要排序的数组(j, k): 将要排序的数组(j, k) = 将要排序的数组(i, k): 将要排序的数组(i, k) = t
Next
End If
Next
Next
Else '降序
For i = y To UBound(将要排序的数组) - 1
For j = i + 1 To UBound(将要排序的数组)
If 将要排序的数组(j, 第2参数的第几列如果是一维填1即可) > 将要排序的数组(i, 第2参数的第几列如果是一维填1即可) Then
'这句话是将J行的数据N个与I行的数据N个互换
For k = x To UBound(将要排序的数组, 2)
t = 将要排序的数组(j, k): 将要排序的数组(j, k) = 将要排序的数组(i, k): 将要排序的数组(i, k) = t
Next
End If
Next
Next
End If
二维数组按第二参数排序 = 将要排序的数组
End Function
怎么不能自己删除自己的帖子啊?也 不能编辑 C:\Documents and Settings\Administrator\My Documents\ACCESS中设置与撤销密码的方法.files\image001.pngC:\Documents and Settings\Administrator\My Documents\ACCESS中设置与撤销密码的方法.files\image001.png C:\Documents and Settings\Administrator\My Documents\ACCESS中设置与撤销密码的方法.files
页:
[1]