Question

我有一个电子表格，其中包含多个标签和数据。对于每个周期，我基本上想要在每个选项卡（不同列）中筛选相同的条件，保存副本（使用今天的日期），然后转到下一个条件并重复该过程，因此我最终得到一个文件夹电子表格，每个标准都会过滤一次。

我的最终目标是循环使用多个变量（如果可能的话，使用表格来输入变量）

经过多次试验和错误，我设法让它过滤并保存副本。然而，该过程仅适用于一个标准。一旦我将它们链接在一起，命名和过滤过程就会因某种原因而中断。我得到多个文件，但命名/过滤不匹配。例如过滤为'Dave'，名为'Ben'

我想我有3个问题：

当流程多次循环时，为什么我的代码无效？
有更简单的方法吗？可能会有一个标准表，然后循环，为每个标准创建一个过滤表。
我无法找到一种方法来阻止每个已保存的文件在循环时打开。理想情况下，我只想在不打开文件的情况下创建文件。

非常感谢帮助。

Sub AutoFilterMacro()
  Dim sct As String
  sct = "Ben"

Worksheets("January").Range("A1").AutoFilter _
 field:=7, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("February").Range("A1").AutoFilter _
 field:=8, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("March").Range("A1").AutoFilter _
 field:=9, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("April").Range("A1").AutoFilter _
 field:=6, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Application.DisplayAlerts = False

 Dim Pre As String
 Pre = Format(Now, "dd-mm-yyyy")
 ThisWorkbook.Sheets.Copy
 With Workbooks(Workbooks.Count)
    .SaveAs ThisWorkbook.Path & "\" & sct & " " & Pre & ".xlsx", 51
 End With

 Application.DisplayAlerts = True

 Call AutoFilterMacro2

End Sub



Sub AutoFilterMacro2()
Dim sct As String
sct = "David"

Worksheets("January").Range("A1").AutoFilter _
 field:=7, _
 Criteria1:="*" & sct & "*", _
 VisibleDropDown:=True

Worksheets("February").Range("A1").AutoFilter _
 field:=8, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("March").Range("A1").AutoFilter _
 field:=9, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Worksheets("April").Range("A1").AutoFilter _
 field:=6, _
 Criteria1:=sct & "*", _
 VisibleDropDown:=True

Application.DisplayAlerts = False

 Dim Pre As String
 Pre = Format(Now, "dd-mm-yyyy")
 ThisWorkbook.Sheets.Copy
 With Workbooks(Workbooks.Count)
     .SaveAs ThisWorkbook.Path & "\" & sct & " " & Pre & ".xlsx", 51
 End With

 Application.DisplayAlerts = True

 Call AutoFilterMacroX

End Sub

Answer 1

假设宏驻留在工作簿中，使用＆＃34; 1月＆＃34;，＆＃34; 2月＆＃34;，...表，您可以试试这个

Option Explicit

Sub AutoFilters()
Dim sheetsToFilter As Variant, sheetName As Variant
Dim sheetsColumnToFilterOn As Variant
Dim criteria As Variant, criterium As Variant
Dim iSht As Long
Dim pre As String

sheetsToFilter = Array("January", "February", "March", "April") '<== place here all the sheets name to be filtered
sheetsColumnToFilterOn = Array(7, 8, 9, 6) '<== place here each correspondant sheet column index on which to base the filter
criteria = Array("Ben", "David") '<== place here your different criteria

pre = Format(Now, "dd-mm-yyyy")

Application.ScreenUpdating = False

For Each criterium In criteria
    For iSht = LBound(sheetsToFilter) To UBound(sheetsToFilter)
        Call Autofilter(ThisWorkbook.Worksheets(sheetsToFilter(iSht)).Range("A1"), CLng(sheetsColumnToFilterOn(iSht)), CStr(criterium))
    Next iSht

    Call CopySheet(sheetsToFilter, ThisWorkbook.Path & "\" & criterium & " " & pre & ".xlsx")
Next criterium

Application.ScreenUpdating = True

End Sub


Sub Autofilter(rng As Range, col As Long, criteria As String)

With rng
    .Autofilter
    .Autofilter field:=col, Criteria1:=criteria & "*", VisibleDropDown:=True
End With

End Sub


Sub CopySheet(sheetsToFilter As Variant, shtName As String)

ThisWorkbook.Worksheets(sheetsToFilter).Copy
ActiveWorkbook.SaveAs Filename:=shtName
ActiveWorkbook.Close False

End Sub

使用VBA

1 个答案: