Question

我正在使用下面的代码尝试遍历文件夹中的大量Excel工作表。我希望代码打开文件，按字母顺序排序，然后进行自定义排序，然后将所有内容复制粘贴到新工作表。如果我在我打开的工作表上运行它，它本身就可以完美地运行。但是，在下面的循环中，没有任何排序，因为它将未排序的值粘贴到新工作表。要清楚，循环通过将所有内容放入一个工作表中，并且排序部分可以工作。只是当它们组合在一起时，排序停止发生。我认为问题是我的代码试图对ThisWorkbook进行排序，而不是刚刚打开的表单，尽管我不确定原因。我对VBA非常陌生。

Sub MergeFiles()

Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

Set dirObj = mergeObj.Getfolder("PATH")
Set filesObj = dirObj.Files
For Each everyObj In filesObj

Set bookList = Workbooks.Open(everyObj)

    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add _
        Key:=Range("A1:ER1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:ER195")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add _
        Key:=Range("A1:ER1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        CustomOrder:="thing1,thing2,thing3", _
        DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:ER195")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

Range("A2:ES" & Range("A196").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

Range("A10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
bookList.Close
Next
End Sub

Answer 1

我认为你好像依赖ActiveWorkbook和ActiveSheeet所持有的状态（和对象）。虽然打开工作簿通常会使其成为ActiveWorkbook，但在ThisWorkbook和最近打开的工作簿之间反弹并不是理想的方法。

Sub MergeFiles()
    Dim bookList As Workbook, wb As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object

    On Error GoTo Fìn
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    Set wb = ThisWorkbook
    Set dirObj = mergeObj.Getfolder("PATH")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        If CBool(InStr(1, filsobj, ".xl", vbTextCompare)) Then
            Set bookList = Workbooks.Open(Filename:=everyObj, ReadOnly:=True)

            With bookList.Sheets(1).Cells(1, 1).Resize(195, 148)
                .Cells.Sort Key1:=.Rows(1), Order1:=xlAscending, _
                            Orientation:=xlLeftToRight, Header:=xlYes, MatchCase:=False, _
                            DataOption:=xlSortNormal
                .Cells.Sort Key1:=.Rows(1), Order1:=xlAscending, _
                            Orientation:=xlLeftToRight, Header:=xlYes, MatchCase:=False, _
                            DataOption:=xlSortNormal, CustomOrder:="thing1,thing2,thing3"
                wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(195, 149) = _
                  .Resize(195, 149).Values
            End With

            debug.print bookList.Name
            bookList.Close SaveChanges:=False
            Set bookList = Nothing
        End If
    Next everyObj
Fìn:
    Set mergeObj = Nothing
    Set wb = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

可以从VBE的立即窗口（又名Ctrl+G）获取已处理工作簿的列表。

在循环访问文件以复制/粘贴到单个工作表时对活动工作表进行排序

1 个答案: