Excel 应用于目录中所有文件的自动筛选

目标：循环浏览文件夹中的所有文件，并根据第1列=“a”为每个文件应用筛选器。然后在应用过滤器的情况下保存到Active工作簿

下面的代码在ActiveSheet.Range（“A1”）处超时。自动筛选字段：=1，标准1:=A，我不知道为什么

Sub FilterApply()

Dim folderName As String
Dim filelocation As String

Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FSOFile As Object
Dim TargetWB As Workbook


'Set the file name to a variable
folderName = "X:\"
filelocation = "X:\"


'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(folderName)
Set FSOFile = FSOFolder.Files


'Apply Autofilter to all sheets in FSOFolder

For Each FSOFile In FSOFile
    If Not ActiveSheet.AutoFilterMode Then
        ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="A"
        ActiveWorkbook.Save
    End If
    Next

在多个文件中应用自动筛选

• 您忘记打开文件：

• 包含处理文件时如何处理文件系统对象的一个很好的示例

• 使用第二个代码，您可以监视正在发生的事情
  在

  即时窗口中

  CRTL+G

• 如果所有工作簿都有同名的工作表，则应正确限定它们，例如

  设置ws=wb.worksheets（“Sheet1”）

  。如果他们只有一份工作表，你就不用麻烦了。但是，如果他们有多个工作表，您可能会得到意外的结果，如果您无法确定上次保存之前哪个工作表处于活动状态

代码

Option Explicit

Sub FilterApply()

    Dim folderName As String
    
    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim FSOFiles As Object
    Dim FSOFile As Object
    
    'Set the file name to a variable
    folderName = "F:\Test\02.07.20"
    
    'Set all the references to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSOLibrary.GetFolder(folderName)
    Set FSOFiles = FSOFolder.Files
    
    'Apply Autofilter to all sheets in FSOFolder
    Dim wb As Workbook
    Dim ws As Worksheet
    For Each FSOFile In FSOFiles
        Set wb = Workbooks.Open(FSOFile.Path)
        Set ws = wb.ActiveSheet ' wb.worksheets("Sheet1") is safer.
        If Not ws.AutoFilterMode Then
            On Error Resume Next
            ws.Range("A1").AutoFilter Field:=1, Criteria1:="A"
            If Err.Number = 0 Then
                wb.Close SaveChanges:=True
            Else
                wb.Close SaveChanges:=False
            End If
            On Error GoTo 0
        Else
            wb.Close SaveChanges:=False
        End If
    Next

End Sub


Sub FilterApplyErr()

    Dim folderName As String
    
    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim FSOFiles As Object
    Dim FSOFile As Object
    
    'Set the file name to a variable
    folderName = "F:\Test\02.07.20"
    
    'Set all the references to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSOLibrary.GetFolder(folderName)
    Set FSOFiles = FSOFolder.Files
    
    'Apply Autofilter to all sheets in FSOFolder
    Dim wb As Workbook
    Dim ws As Worksheet
    For Each FSOFile In FSOFiles
        Set wb = Workbooks.Open(FSOFile.Path)
        Set ws = wb.ActiveSheet ' wb.worksheets("Sheet1") is safer.
        If Not ws.AutoFilterMode Then
            On Error Resume Next
            ws.Range("A1").AutoFilter Field:=1, Criteria1:="A"
            Select Case Err.Number
                Case 0
                    Debug.Print "The data in worksheet '" & ws.Name _
                              & "' of workbook '" & wb.Name _
                              & "' was filtered now."
                    wb.Close SaveChanges:=True
                Case 1004
                    If Err.Description = "AutoFilter method of Range class " _
                                       & "failed" Then
                        Debug.Print "Worksheet '" & ws.Name & "' in workbook " _
                                  & "'" & wb.Name & "' has no data in cell " _
                                  & "'A1'."
                        wb.Close SaveChanges:=False
                    Else
                        Debug.Print "Run-time error '" & Err.Number _
                                  & "': " & Err.Description
                        wb.Close SaveChanges:=False
                End If
            Case Else
                Debug.Print "Run-time error '" & Err.Number _
                          & "': " & Err.Description
                wb.Close SaveChanges:=False
            End Select
            On Error GoTo 0
        Else
            Debug.Print "The data in worksheet '" & ws.Name _
                      & "' of workbook '" & wb.Name _
                      & "' had already been filtered."
            wb.Close SaveChanges:=False
        End If
    Next

End Sub