归并算法对二维数组的多列依次排序

cgzn

Option Compare Text '放模块最顶部

'排序规则SortRule的格式为"1,-2,3"...，其中-2的-表示降序排列，2表示对arr的2列排序，顺序从1-3列依次排序

Sub ColsPX(arr, SortRule, Optional lt = -1, Optional rt = -1, Optional px = 0)
    If lt = -1 Then lt = LBound(arr)
    If rt = -1 Then rt = UBound(arr)
    If px = 0 Then MergSort1 arr, SortRule, lt, rt: px = 1
    pxr = Split(SortRule, ","): j1 = pxr(px - 1): j = Abs(j1): If px <= UBound(pxr) Then j0 = pxr(px)
    If lt < rt And px <= UBound(pxr) Then
        For i = lt + 1 To rt
            If arr(i, j) = arr(i - 1, j) Then n = n + 1 Else n0 = n: n = 0
            If n0 > 0 And n = 0 Then
                rtn = i - 1: ltn = i - 1 - n0: MergSort1 arr, j0, ltn, rtn: ColsPX arr, SortRule, ltn, rtn, px + 1
            ElseIf i = rt And n > 0 Then rtn = rt: ltn = i - n: MergSort1 arr, j0, ltn, rtn: ColsPX arr, SortRule, ltn, rtn, px + 1
            End If
        Next
    End If
End Sub

Sub MergSort1(arr, SortRule, Optional lt = -1, Optional rt = -1)
    pxr = Split(SortRule, ","): subsize = 1: Dim tmprr(): Dim jd As Long: jd = pxr(0)
    If lt = -1 Then lt = LBound(arr)
    If rt = -1 Then rt = UBound(arr)
    ci = LBound(arr, 2): cend = UBound(arr, 2): ReDim tmprr(lt To rt, ci To cend)
    While subsize < rt - lt + 1
        lf = lt
        While lf < rt
            md = Application.Min(lf + subsize - 1, rt): rg = Application.Min(lf + 2 * subsize - 1, rt)
            For i = lf To rg
                For j = ci To cend
                    tmprr(i, j) = arr(i, j)
                Next
            Next
            i = lf: j = md + 1: k = lf
            While i <= md And j <= rg
                If tmprr(i, Abs(jd)) < tmprr(j, Abs(jd)) And jd > 0 Or tmprr(i, Abs(jd)) > tmprr(j, Abs(jd)) And jd < 0 Then
2:                      arr(k, ci) = tmprr(i, ci): If ci < cend Then ci = ci + 1: GoTo 2 Else ci = LBound(arr, 2)
                    i = i + 1
                Else
7:                      arr(k, ci) = tmprr(j, ci): If ci < cend Then ci = ci + 1: GoTo 7 Else ci = LBound(arr, 2)
                    j = j + 1
                End If
                k = k + 1
            Wend
            While i <= md
5:                  arr(k, ci) = tmprr(i, ci): If ci < cend Then ci = ci + 1: GoTo 5 Else ci = LBound(arr, 2)
                i = i + 1: k = k + 1
            Wend
            While j <= rg
6:                  arr(k, ci) = tmprr(j, ci): If ci < cend Then ci = ci + 1: GoTo 6 Else ci = LBound(arr, 2)
                j = j + 1: k = k + 1
            Wend
            lf = lf + 2 * subsize
        Wend
        subsize = subsize * 2
    Wend
End Sub

cgzn

对二维数组多列依此排序，我找了好久没有找到。自己花一天时间参照归并排序的方法写了一个，欢迎大佬指正。
效率还是没法和excel自带的排序方法比较，不知道这家伙用的什么排序方法。不过这个归并算法的速度也能接受了，16万行4列依次排序，10秒左右，1万行以内基本1秒不到。


使用时直接调用ColsPX arr,SortRule

ykcbf1100

建议楼主上传几个实例。

cgzn

ykcbf1100 发表于 2024-7-31 20:51
建议楼主上传几个实例。

已上传实例，请测试。

songshihai

老师!后面的几个参数(lt,rt,px)是什么意思呢?

ykcbf1100

cgzn 发表于 2024-8-1 15:26
已上传实例，请测试。

挺好的。
有实例主要是为了能更好的理解你这个数组的排序使用方法，便于推广。

ykcbf1100

楼主最好解释一下几个参数的含义，lt应该是数组的下标，rt应该是数组的上标，px的含义不清楚。

cgzn

songshihai 发表于 2024-8-1 16:05
老师!后面的几个参数(lt,rt,px)是什么意思呢?

lt是排序的二维数组的起始位置，rt是终点位置。
或者说，仅对二维数组的第lt行到第rt行排序。

ykcbf1100

cgzn 发表于 2024-8-1 17:00
lt是排序的二维数组的起始位置，rt是终点位置。
或者说，仅对二维数组的第lt行到第rt行排序。

px是干啥的？

cgzn

ykcbf1100 发表于 2024-8-1 16:20
楼主最好解释一下几个参数的含义，lt应该是数组的下标，rt应该是数组的上标，px的含义不清楚。

pxr是sortrule按英文逗号拆分的数组
比如：sortrule=”-1,-2,3,4"  是依此按arr的第一列降序，第二列降序，第三列升序，第四列升序排列
pxr=split(sortrule,",")
px就是pxr的下标，例如：px=1，pxr(px)=-2；px=2，pxr(px)=3