Исправление макроса для фильтрации - PullRequest
0 голосов
/ 22 марта 2019

У меня есть этот макрос для фильтрации листа, но сейчас он предполагает, что заголовки находятся только в строке 1 ... как мне предположить, что заголовки - это строки 1-4? (иначе фильтр начинается в строке 4)

Это в основном для фильтрации таблицы и сохранения их в виде PDF в одном из наших файлов

Dim TempWks As Worksheet
Dim wks As Worksheet

Dim myRng As Range
Dim myCell As Range

'change to match your worksheet name
Set wks = Worksheets("Sheet3")

Set TempWks = Worksheets.Add

wks.AutoFilterMode = False 'remove the arrows

'assumes headers only in row 1
wks.Columns(1).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=TempWks.Range("A1"), Unique:=True

With TempWks
    Set myRng = .Range("a4", .Cells(.Rows.Count, "A").End(xlUp))
End With

With wks
    For Each myCell In myRng.Cells
        .UsedRange.AutoFilter Field:=1, Criteria1:=myCell.Value
Dim MyFileName As Variant
Dim MyfilePath As Variant

MyfilePath = "xxx" 'File Location

MyFileName = MyfilePath & "\" & myCell.Value & ".pdf" 'File Name

    ChDir _
    MyfilePath


wks.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
  MyFileName, Quality:= _
     xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
  OpenAfterPublish:=False
    Next myCell
End With

Application.DisplayAlerts = False
TempWks.Delete
Application.DisplayAlerts = True

Ответы [ 2 ]

0 голосов
/ 22 марта 2019

Возможно, причиной было использование .UsedRange. Если это всегда из 4-й строки, попробуйте заменить .UsedRange.AutoFilter ... на Intersect (.UsedRange, .UsedRange.Offset (4,0)). AutoFilter ...

0 голосов
/ 22 марта 2019

Вы можете сделать что-то вроде этого:

With wks.Range(wks.Cells(4,1), wks.Cells(rows.Count, 1).End(xlUp))
    .AdvancedFilter Action:=xlFilterCopy, _
                    CopyToRange:=TempWks.Range("A1"), Unique:=True
End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...