Использование автофильтра с петлей - PullRequest
Новая
       5

Использование автофильтра с петлей

0 голосов
/ 05 февраля 2019

Я пытаюсь применить фильтр к нескольким книгам в папке.Цикл в моем коде работает для открытия всех файлов .xlsm в данной папке, но у меня возникают проблемы с применением цикла к фильтру.Мне нужен один и тот же фильтр для применения ко всем рабочим книгам.

Надеюсь, я действительно близок к тому, чтобы это получить, и просто мне чего-то не хватает здесь.

Открывается первый, более длинный макросвсе .xlsm файлы в данной папке, но только автофильтры активной книги, но не все открытые книги.Второй макрос - моя попытка упростить макрос, но безуспешно, за исключением того, что открывается диалоговое окно файла, и я могу выбрать папку, но после этого ничего не происходит.Файлы не открыты или не отфильтрованы.

В этом макросе я получаю

Ошибка времени выполнения 438: объект не поддерживает это свойство или метод

в .autofilter field:=1....

Sub Main()

    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Application.ScreenUpdating = False
    On Error Resume Next
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    xFile = Dir(xStrPath & "\*.xlsm")
    Do While xFile <> ""
        Workbooks.Open xStrPath & "\" & xFile
        xFile = Dir
    Loop

'Filter_Rows_By_RSSID

    For Each xWB In Application.Workbooks
    With Worksheets("Sheet1").Range("A1")
        .AutoFilter field:=1, Criteria1:=Array("5649", "15899", "16583", "27314", "27471", "32551", "33111", "33124", "34404", "34607", "35157", "35331", "35546", "57203", "57450", "57803", "58119", "58413"), Operator:=xlFilterValues
    End With

    Next

End Sub

Sub BadLoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
            .AutoFilter field:=1, Criteria1:=Array("5649", "15899", "16583", "27314", "27471", "32551", "33111", "33124", "34404", "34607", "35157", "35331", "35546", "57203", "57450", "57803", "58119", "58413"), Operator:=xlFilterValues
            End With
           xFileName = Dir
        Loop
    End If
End Sub

1 Ответ

0 голосов
/ 05 февраля 2019

Ваш With блок 

With Workbooks.Open(xFdItem & xFileName)
    .AutoFilter field:=1, Criteria1:=Array("5649", "15899", "16583", "27314", "27471", "32551", "33111", "33124", "34404", "34607", "35157", "35331", "35546", "57203", "57450", "57803", "58119", "58413"), Operator:=xlFilterValues
End With

вызовет эту ошибку, поскольку вы не указываете ни рабочий лист, ни диапазон для своего автофильтра.

Вы можете установить переменную = рабочую книгуВы открываете и ссылаетесь на рабочий лист и диапазон на автофильтр.Затем вы можете удалить блок With, поскольку вы используете его только для этого. 

Dim wb as Workbook

Set wb = Workbooks.Open(xFdItem & xFileName)
wb.Worksheets(1).Range("A1").AutoFilter field:=1, Criteria1:=Array("5649", "15899", "16583", "27314", "27471", "32551", "33111", "33124", "34404", "34607", "35157", "35331", "35546", "57203", "57450", "57803", "58119", "58413"), Operator:=xlFilterValues
...