多条件下的自定义序列排序怎么做？

lrsh1985

zhaogang1960 发表于 2011-8-23 17:31
我在2010中测试正常，不管是保存为2003，还是2010，请看演示：

谢谢了，可是我用2007真死机啊

lrsh1985

zhaogang1960 发表于 2011-8-23 17:31
我在2010中测试正常，不管是保存为2003，还是2010，请看演示：

我用同事的2003版本做可以做，用我的2007版本就不行了，第一遍好使，第二遍再运行的时候就出错了，弹出以下提示

zhaogang1960

lrsh1985 发表于 2011-8-24 08:24
我用同事的2003版本做可以做，用我的2007版本就不行了，第一遍好使，第二遍再运行的时候就出错了，弹出以 ...

在2007中测试，只要第4条件使用新录制的代码就可以了：
Sub Macro1()
    Dim arr(2), rng As Range, n%, lr&, i%
    lr = [bc65536].End(xlUp).Row
    Set rng = Range("BC2:BP" & lr)
    a = Array(55, 57, 59)
    arr(2) = Array("B", "E", "F", "G", "M", "L", "H") '第一条件，最后排序
    arr(1) = Array("A", "3", "1", "9", "4")
    arr(0) = Array("1", "5", "3", "4")
    With Application
        .ScreenUpdating = False
        Call 第4条件(rng)
'        rng.Sort Key1:=[bk2].Resize(lr - 1), Order1:=xlAscending '第4条件，首先排序
        For i = 0 To 2
            .AddCustomList ListArray:=arr(i)
            n = .GetCustomListNum(arr(i))
            rng.Sort Key1:=Cells(2, a(i)).Resize(lr - 1), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=n + 1
            .DeleteCustomList ListNum:=n
        Next
        .ScreenUpdating = True
    End With
End Sub
Sub 第4条件(rng As Range)
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("BK2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange rng
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

lrsh1985

zhaogang1960 发表于 2011-8-24 09:28
在2007中测试，只要第4条件使用新录制的代码就可以了：
Sub Macro1()
    Dim arr(2), rng As Range, n ...

谢谢版主：）