[已解决]对多个工作簿进行自定义排序，太多，太繁琐了，求个代码

小敏同学

首先在E列添加公式（=IF(COUNTIF([标准件清单.xlsx]Sheet1!$A$1:$A$522,C3),"1","2"）），对C列进行材料分类，后对E列跟C列进行自定义排序，E列优先，BCD3列对应的数据不能乱，一般都有150个左右的工作簿。

最佳答案

月排行榜 / 总排行榜

hasyh2008

2022-8-3 08:51

Sub 排序()
    Dim fso As Object
    Dim Wb As Workbook
    Dim Sh As Worksheet
    Dim D As Object
    Dim R&, Ar, f, T
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    T = Timer
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set D = CreateObject("scripting.dictionary")
    With Sheet1
        Ar = .[A1].CurrentRegion
        For R = 1 To UBound(Ar)
            D(Ar(R, 1)) = ""
        Next R
    End With
    For Each f In fso.getfolder(ThisWorkbook.Path).Files
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
            With Workbooks.Open(f)
                For Each Sh In .Worksheets
                    If Application.CountA(Sh.Cells) > 0 Then
                        With Sh
                            R = .Cells(.Rows.Count, 3).End(xlUp).Row
                            Ar = .Cells(3, 1).Resize(R - 2, 5)
                            For R = 1 To UBound(Ar)
                                If D.exists(Ar(R, 3)) Then
                                    Ar(R, 5) = "1"
                                Else
                                    Ar(R, 5) = "2"
                                End If
                            Next R
                            .Cells(3, 1).Resize(UBound(Ar), 5) = Ar
                            .Sort.SortFields.Clear
                            .Sort.SortFields.Add Key:=.Range("E3:E" & UBound(Ar) + 2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            .Sort.SortFields.Add Key:=.Range("C3:C" & UBound(Ar) + 2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With .Sort
                                .SetRange Range("A3:E" & UBound(Ar) + 2)
                                .Header = xlGuess
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                            .Columns("E") = ""
                        End With
                    End If
                Next Sh
                .Save
                .Close False
            End With
        End If
    Next f
    MsgBox "用时：" & Format(Timer - T, "0.00\秒")
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

跳转到最佳答案楼层

hasyh2008

Sub 排序()
    Dim fso As Object
    Dim Wb As Workbook
    Dim Sh As Worksheet
    Dim D As Object
    Dim R&, Ar, f, T
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    T = Timer
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set D = CreateObject("scripting.dictionary")
    With Sheet1
        Ar = .[A1].CurrentRegion
        For R = 1 To UBound(Ar)
            D(Ar(R, 1)) = ""
        Next R
    End With
    For Each f In fso.getfolder(ThisWorkbook.Path).Files
        If InStr(f.Name, ThisWorkbook.Name) = 0 Then
            With Workbooks.Open(f)
                For Each Sh In .Worksheets
                    If Application.CountA(Sh.Cells) > 0 Then
                        With Sh
                            R = .Cells(.Rows.Count, 3).End(xlUp).Row
                            Ar = .Cells(3, 1).Resize(R - 2, 5)
                            For R = 1 To UBound(Ar)
                                If D.exists(Ar(R, 3)) Then
                                    Ar(R, 5) = "1"
                                Else
                                    Ar(R, 5) = "2"
                                End If
                            Next R
                            .Cells(3, 1).Resize(UBound(Ar), 5) = Ar
                            .Sort.SortFields.Clear
                            .Sort.SortFields.Add Key:=.Range("E3:E" & UBound(Ar) + 2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            .Sort.SortFields.Add Key:=.Range("C3:C" & UBound(Ar) + 2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With .Sort
                                .SetRange Range("A3:E" & UBound(Ar) + 2)
                                .Header = xlGuess
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
                            .Columns("E") = ""
                        End With
                    End If
                Next Sh
                .Save
                .Close False
            End With
        End If
    Next f
    MsgBox "用时：" & Format(Timer - T, "0.00\秒")
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

小敏同学

hasyh2008

不知道你的自定义规则，就随便排了下序。

小敏同学

hasyh2008 发表于 2022-8-3 10:49
不知道你的自定义规则，就随便排了下序。

这样子不对，C列跟E列都是升序，E列优先，可以的话，执行完排序了可以直接把E列的数据删了

hasyh2008

                .Cells(2, 1).Resize(UBound(Ar) + 1, 5).Sort key1:="是否标准件", order1:=xlAscending, Header:=xlYes
                .Cells(2, 1).Resize(UBound(Ar) + 1, 5).Sort key1:="模板编号", order1:=xlAscending, Header:=xlYes

如果不对的话，把这两句调换下位置。

小敏同学

hasyh2008 发表于 2022-8-3 11:58
.Cells(2, 1).Resize(UBound(Ar) + 1, 5).Sort key1:="是否标准件", order1:=xlAscending, ...

不好意思啊，还是不能用，就是是否标准件那一个命令错误

hasyh2008

把你的要求表述清楚

小敏同学

hasyh2008 发表于 2022-8-3 13:42
把你的要求表述清楚

会有很多个这样的工作簿，我按我平时的操作来说吧，在E列输入公式判断模板型号是否是标准件，是为1，不是为2，然后选择工程编码，模板编号，数量，是否标准件以下的所有内容，进行自定义排序，E列跟C列，他们是同时排序的，E列是主要关键词，C列是次要，全部操作好再删除E列内容。。要是简单的话再加个合并文件，多个工作簿放在一个文件里

hasyh2008

自定义排序，就要有自定义排序的规则，这个规则你没说啊。