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

编程问答 2022-06-10

问题描述

目标：循环浏览文件夹中的所有文件，并对每个文件应用基于列1 =“ A”的过滤器。然后在应用过滤器的情况下保存在ActiveWorkbook上。

以下内容在ActiveSheet.Range（“ A1”）。AutoFilter Field：= 1，Criteria1：=“ 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

解决方法

在多个文件中应用自动过滤器

  • 您忘记打开文件：Workbooks.Open。

  • This page很好地说明了在处理文件时如何处理文件系统对象。

  • 使用第二个代码，您可以监视正在发生的事情
    在Immediate window CRTL + G 中。

  • 如果所有工作簿都具有相同名称的工作表，则应适当限定它们的名称，例如Set 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
autofilterexcelexcelloops