使用 VBA 在 Excel 中设置过滤器

Set filter in Excel with VBA

提问by jimz

The below macro will allow me to find a name in the heading in sheet 1 and copy the entire column to sheet 2. Now I want to continue the code, but am facing a problem, which I will try explain.

下面的宏将允许我在工作表 1 的标题中找到一个名称并将整列复制到工作表 2。现在我想继续代码，但遇到了一个问题，我将尝试解释。

Sub CopyColumnByTitle()
'Find "Name" in Row 1
  With Sheets(1).Rows(1)
   Set t = .Find("Name", lookat:=xlpart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
     If Not t Is Nothing Then
        Columns(t.Column).EntireColumn.Copy _
          Destination:=Sheets(2).Range("A1")
       Else: MsgBox "Title Not Found"
     End If
  End With
End Sub

after all data is pasted in the sheet 2 as below ....

在将所有数据粘贴到工作表 2 后，如下所示......

Sheet 2
Name Age Address    Date of Birth
John    25  US  1-Sep-11
Hary    26  US  1-Sep-11
John    27  UK  1-Sep-11
Hary    28  US  2-Sep-11
King    29  UK  3-Sep-11
Peter   30  US  3-Sep-11

I need to set filters as shown below and copy the filtered data to sheet 3 as above code does:

我需要设置如下所示的过滤器，并将过滤后的数据复制到表 3 中，如上代码所示：

1. I need to set filter criteria on sheet 2 which helps me to see Names that are equal to "John" or "Hary" and copy and paste the entire data into sheet 3.
2. I need to set another filter where Nameis equal to "John" and Date of Birthis equal to "1-Sep-11" (note the date should always be yesterday). Copy and paste the entire data into sheet 4.
3. On the third time, I need to set a filter where Nameis equal to "King" and copy the and past the entire data into sheet 5.

1. 我需要在工作表 2 上设置过滤条件，这有助于我查看Name等于“John”或“Hary”的 s，并将整个数据复制并粘贴到工作表 3 中。
2. 我需要设置另一个过滤器，其中Name等于“John”并且Date of Birth等于“1-Sep-11”（注意日期应该总是昨天）。将整个数据复制并粘贴到工作表 4 中。
3. 第三次，我需要设置一个Name等于“King”的过滤器，并将整个数据复制并粘贴到工作表 5 中。

---

---

Thanks a lot John for your reply, the reply you gave is effective but I have already designed my code due of the urgent requirements.

非常感谢约翰的回复，你的回复是有效的，但由于紧急需求，我已经设计了我的代码。

I need a slight help in same. I am pasting some part of code as it is not possible to paste the entire code.

我需要一点帮助。我正在粘贴部分代码，因为无法粘贴整个代码。

The code allows me to copy data from one workbook to another, but while copying data, I need to copy an entire column because there are some blank cells in it. So if I don't use .EntireColumn, the macro does not copy cells after the blank cell. Also now, while pasting the data into the other work book, I need to paste it without the heading.

该代码允许我将数据从一个工作簿复制到另一个工作簿，但是在复制数据时，我需要复制一整列，因为其中有一些空白单元格。因此，如果我不使用.EntireColumn，则宏不会在空白单元格之后复制单元格。现在，在将数据粘贴到其他工作簿中时，我需要将其粘贴而不带标题。

I would be grateful if you help me out with this.

如果你能帮我解决这个问题，我将不胜感激。

Windows("macro2.xlsm").Activate
Range(Range("M2"), Range("N2").End(xlDown)).EntireColumn.Select
Application.CutCopyMode = False
Selection.Copy
Windows("formula.xls").Activate
Range(Range("I2"), Range("J2").End(xlDown)).EntireColumn.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

回答by niko

Task 1:

任务1：

 thisworkbook.sheets(2).activate
 activesheet.range("A:A").select 'set column you filter for probable names here
 Selection.AutoFilter Field:=1, Criteria1:="=John", Operator:=xlOr, _
 Criteria2:="=Hary" ' filters  only for hary or john 
 activate.usedrange.select ' now select the filtered sheet to copy  
 selection.copy 
 ActiveSheet.ShowAllData ' now retain back the data so that you get your original file
 thisworkbook.sheets(3).activate  'select your sheet3 and paste it
 activate.range("A1").select
 activesheet.paste

Task 2:

任务 2：

 thisworkbook.sheets(2).activate
 activesheet.range("A:A").select \'set column you filter for probable names here
 Selection.AutoFilter Field:=1, Criteria1:="John" \ filters for john
 Selection.AutoFilter Field:=2, Criteria1:="1-sep-2011"  \ filters for date only for john rows 
 activate.usedrange.select ' now select the filtered sheet to copy  
 selection.copy 
 ActiveSheet.ShowAllData ' now retain back the data so that you get your original file
 thisworkbook.sheets(4).activate  'select your sheet3 and paste it
 activate.range("A1").select
 activesheet.paste

Task 3

任务 3

 thisworkbook.sheets(2).activate
 activesheet.range("A:A").select 'set column you filter for probable names here
 Selection.AutoFilter Field:=1, Criteria1:="=King" ' filters  only king 
 activate.usedrange.select ' now select the filtered sheet to copy  
 selection.copy 
 ActiveSheet.ShowAllData ' now retain back the data so that you get your original file
 thisworkbook.sheets(5).activate  'select your sheet3 and paste it
 activate.range("A1").select
 activesheet.paste

Probably It might give you some idea how to do it. any more doubt feel free to ask me.

可能它可能会给你一些想法如何去做。有任何疑问随时问我。

Thanks! You could probably go for copy destination:= and many more way to do it . actually I have to go now so i just gave you a sample piece to work on.

谢谢！你可能会去复制目的地：= 和更多的方法来做到这一点。实际上我现在必须走了，所以我只是给了你一个样本来处理。