针对数组的多标准排序，谢谢无关岁月、ykcbf1100、usedrange老师！

lhj323323

ykcbf1100 发表于 2024-8-20 06:58
多列数组排序的话，排序自定义函数要换一个。

自定义函数
5楼的，与4楼的是不是一样的？

lhj323323

ykcbf1100 发表于 2024-8-20 06:58
如果一定要用数组排序，那就这样吧。

本月内的前一次求助
是针对数组的单标准排序
后来在添加数据库时
才发现【数据提供者】提供的数据并不规范
同一列的日期，既然存在多个日期
所以，才有今天的求助。
改为数组的多标准排序。

lhj323323

Qs18 发表于 2024-8-20 07:27
Sub qs()
    Dim rng As Range
    Set rng = Sheet1.Range("a1:c" & Sheet1.Cells(Rows.Count, 3).End( ...

谢谢老师，
我需要的是针对数组的排序
而附件里的ABC本是不存在的。

ykcbf1100

lhj323323 发表于 2024-8-20 08:06
针对4楼的数组排序

我把数据源由一组（3列），改为N组（每组3列）

不要用一个数组，分开处理吧。

ykcbf1100

lhj323323 发表于 2024-8-20 08:07
自定义函数
5楼的，与4楼的是不是一样的？

4、5楼是同一个东西

liulang0808

Sub 按钮44_Click()
    arr = [a1].CurrentRegion
    brr = [a1].CurrentRegion
Sub 按钮44_Click()
    arr = [a1].CurrentRegion
    brr = [a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For j = 2 To UBound(arr)
        If Not d.exists(arr(j, 2)) Then
            Set d(arr(j, 2)) = CreateObject("scripting.dictionary")
        End If
        d(arr(j, 2))(arr(j, 3)) = d(arr(j, 2))(arr(j, 3)) & "," & j
    Next j
    r = 1
    For j = 1 To d.Count
        m = WorksheetFunction.Large(d.keys, j)
        For i = 1 To d(m).Count
            n = WorksheetFunction.Small(d(m).keys, i)
            crr = Split(d(m)(n), ",")
            r = r + 1
            For x = 1 To UBound(crr)
                For y = 1 To UBound(arr, 2)
                    brr(r, y) = arr(Val(crr(x)), y)
                Next y
            Next x
        Next i
    Next j
    [w1].Resize(UBound(arr), UBound(arr, 2)) = brr
End Sub

liulang0808

arr跟brr可以修改对应的区域，供参考

lhj323323

ykcbf1100 发表于 2024-8-20 08:21
不要用一个数组，分开处理吧。

不好意思
10楼的数据源里的第二组，应在D列，而不是E列。
此时，10楼的源码生成的结果就是正确的了。

ykcbf1100

lhj323323 发表于 2024-8-20 09:12
不好意思
10楼的数据源里的第二组，应在D列，而不是E列。
此时，10楼的源码生成的结果就是正确的了。

那相应代码改一下就行了。

gwjkkkkk

请参考附件，排二次就可以了。。。