VBA根据其中标题列不断变化的两个标准过滤值

在VBA中，我logging了下面的代码：Col E =“Currency”Col B =“Policy”

它应该做的是..

1. 列标题货币和政策不断变化，所以他们应该自动查找名称..
2. 上涨货币应过滤为“美元”和上限政策应筛选为“威利斯PCard”比过滤结果应复制到新的名单命名为“P卡 – ”
3. Col货币应过滤为“美元”和上限政策应过滤为“威利斯”和“威利斯重新”，这两个都应复制到新的名单命名为“美国”

`

Sub Filter() ' ' Filter Macro ' ' Rows("1:1").Select Selection.AutoFilter ActiveSheet.Range("$A$1:$R$337").AutoFilter Field:=5, Criteria1:="USD" ActiveSheet.Range("$A$1:$R$337").AutoFilter Field:=2, Criteria1:= _ "Willis PCard" Cells.Select Selection.Copy Sheets.Add After:=Sheets(Sheets.Count) Sheets("Sheet1").Name = "P Card - " ActiveSheet.Paste Sheets("ProcessorReportsList").Select Application.CutCopyMode = False ActiveSheet.Range("$A$1:$R$337").AutoFilter Field:=2, Criteria1:="=Willis" _ , Operator:=xlOr, Criteria2:="=Willis RE" ActiveSheet.Range("$A$1:$R$337").AutoFilter Field:=18, Criteria1:="<>" Cells.Select Selection.Copy ActiveWindow.SmallScroll ToRight:=1 Sheets.Add After:=Sheets(Sheets.Count) Sheets("Sheet2").Select Sheets("Sheet2").Name = "US on Hold - " ActiveSheet.Paste Sheets("ProcessorReportsList").Select Application.CutCopyMode = False ActiveSheet.Range("$A$1:$R$337").AutoFilter Field:=18, Criteria1:="=" Cells.Select Selection.Copy Sheets.Add After:=Sheets(Sheets.Count) Sheets("Sheet3").Select Sheets("Sheet3").Name = "US - " ActiveSheet.Paste Cells.Select Cells.EntireColumn.AutoFit Sheets("US on Hold - ").Select Cells.Select Cells.EntireColumn.AutoFit Sheets("P Card - ").Select Cells.Select Cells.EntireColumn.AutoFit Range("A1").Select Sheets("ProcessorReportsList").Select Cells.Select Cells.EntireColumn.AutoFit Application.CutCopyMode = False Selection.AutoFilter End Sub 

然而， 结果似乎意外

任何帮助将不胜感激。

Answer 1

看到一个更干净的方式来执行你的愿望下面。 请注意，这只适用于美元和“Willie PCard”，您需要为其他AutoFilter等进行编辑。

  Sub FilterAndCopy() Dim DataWorkBook As Workbook Set DataWorkBook = ThisWorkbook Dim DataWorkSheet As Worksheet Set DataWorkSheet = DataWorkBook.Sheets("ProcessorReportList") Dim FirstRowRange As Range Dim CurrencyColumn As Long Dim PolicyColumn As Long Set FirstRowRange = DataWorkSheet.Rows(1).Find("Currency") CurrencyColumn = FirstRowRange.Column Set FirstRowRange = DataWorkSheet.Rows(1).Find("Policy") PolicyColumn = FirstRowRange.Column FirstRowRange.AutoFilter Field:=CurrencyColumn, Criteria1:="USD" FirstRowRange.AutoFilter Field:=PolicyColumn, Criteria1:="Willis PCard" DataWorkSheet.UsedRange.Copy Dim PCard9Sheet As Worksheet Set PCard9Sheet = DataWorkBook.Sheets.Add(After:=DataWorkBook.Sheets("ProcessorReportList")) PCard9Sheet.Name = "P Card - 9" PCard9Sheet.Paste End Sub