打开APP
userphoto
未登录

开通VIP,畅享免费电子书等14项超值服

开通VIP
VBA二维数组排序
Sub tmp()
    Dim tmp
    tmp = [A1:C10]
    tmp = ArraySort(tmp, 1, DESCENDING_ORDER, 3, ASCENDING_ORDER)
    [I1].Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
End Sub

Function ArraySort(tmp, ByVal Key1 As Integer, ByVal Order1 As eOrderType, ByVal Key2 As Integer, ByVal Order2 As eOrderType)
    Dim i As Integer, j As Integer, Nm As Integer, Nsorted As Integer, r As Integer, m As Double
    Dim tmp0, tmp1
    ReDim tmp0(LBound(tmp, 1) To UBound(tmp, 1), LBound(tmp, 2) To UBound(tmp, 2))
    ReDim tmp1(LBound(tmp, 1) To UBound(tmp, 1), LBound(tmp, 2) To UBound(tmp, 2))
    On Error Resume Next
    Nsorted = 0
    If Order1 = ASCENDING_ORDER Then
        Do While Nsorted < (UBound(tmp, 1) - LBound(tmp, 1) + 1)
            m = Application.Min(Application.Index(tmp, , Key1))
            Nm = 0
            For i = LBound(tmp, 1) To UBound(tmp, 1)
                If tmp(i, Key1) = m Then
                    Nm = Nm + 1
                    For j = LBound(tmp, 2) To UBound(tmp, 2)
                        tmp0(Nm, j) = tmp(i, j)
                        tmp(i, j) = ""
                    Next j
                End If
            Next i
            For i = 1 To Nm
                Nsorted = Nsorted + 1
                If Order2 = ASCENDING_ORDER Then
                    m = Application.Min(Application.Index(tmp0, , Key2))
                ElseIf Order2 = DESCENDING_ORDER Then
                    m = Application.Max(Application.Index(tmp0, , Key2))
                End If
                r = Application.WorksheetFunction.Match(m, Application.Index(tmp0, , Key2), 0)
                For j = LBound(tmp, 2) To UBound(tmp, 2)
                    tmp1(Nsorted, j) = tmp0(r, j)
                    tmp0(r, j) = ""
                Next j
            Next i
        Loop
    ElseIf Order1 = DESCENDING_ORDER Then
        Do While Nsorted < (UBound(tmp, 1) - LBound(tmp, 1) + 1)
            m = Application.Max(Application.Index(tmp, , Key1))
            Nm = 0
            For i = LBound(tmp, 1) To UBound(tmp, 1)
                If tmp(i, Key1) = m Then
                    Nm = Nm + 1
                    For j = LBound(tmp, 2) To UBound(tmp, 2)
                        tmp0(Nm, j) = tmp(i, j)
                        tmp(i, j) = ""
                    Next j
                End If
            Next i
            For i = 1 To Nm
                Nsorted = Nsorted + 1
                If Order2 = ASCENDING_ORDER Then
                    m = Application.Min(Application.Index(tmp0, , Key2))
                ElseIf Order2 = DESCENDING_ORDER Then
                    m = Application.Max(Application.Index(tmp0, , Key2))
                End If
                r = Application.WorksheetFunction.Match(m, Application.Index(tmp0, , Key2), 0)
                For j = LBound(tmp, 2) To UBound(tmp, 2)
                    tmp1(Nsorted, j) = tmp0(r, j)
                    tmp0(r, j) = ""
                Next j
            Next i
        Loop
    End If
    ArraySort = tmp1
End Function
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报
打开APP,阅读全文并永久保存 查看更多类似文章
猜你喜欢
类似文章
VBA数组函数UBound.lbound
VBA进阶 | 数组基础02: 简单的数组操作
VBA进阶 | 数组基础03: 二维数组
VBA进阶|利用VBA数组管理数据清单和表格
怎样从一个数组中找出另一个数组不同内容(vba三法)
VBA中LBound和UBound的含义
更多类似文章 >>
生活服务
热点新闻
分享 收藏 导长图 关注 下载文章
绑定账号成功
后续可登录账号畅享VIP特权!
如果VIP功能使用有故障,
可点击这里联系客服!

联系客服