使用高级filter将数据复制到单独的表单中

我想过滤使用自动filter或高级filter

我有一个有400Klogging的Excel工作表

我有一个31字母数字数据的列表

如果字段“K”得到了这些31个字母数字数据中的任何一个，我必须从母表复制logging

我试着跟着。 它不起作用。 你的帮助将不胜感激。

Sub AAA_MyFilter() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim rng1 As Long Dim rng2 As Long Dim rng3 As Long Dim rng4 As Long Dim i As Long Dim x As Long Dim y As Long Set ws1 = Worksheets("Active") ' Data Set ws2 = Worksheets("NYorkPstlCode") ' Criteria Set ws3 = Worksheets("Consolidated") ' Output rng1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row rng2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row rng3 = ws3.Cells(Rows.Count, "A").End(xlUp).Row rng4 = ws1.Cells(Rows.Count, "J").End(xlUp).Row For i = 2 To rng4 Set fltrDataField = ws1.Range("J" & i) For x = 2 To rng2 Set filtrListField = ws2.Range("A" & x) For y = 2 To rng3 ws1.Range("j" & i).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=ws2.Range("A" & x), _ CopyToRange:=ws3.Range("A2" & y), _ Unique:=False Next y Next x Next i End Sub 

Answer 1

Sub ProcessWorkSheets()已过滤的数据从“活动”和“被动”表复制到“合并”

（如果Active.ColK或Passive.ColK包含来自NYorkPstlCode.ColA的值）

---

 Option Explicit Public Sub ProcessWorkSheets() With Application.ThisWorkbook ConsolidatePostalCodes .Worksheets("Active") 'Last row determined by vals in col A ConsolidatePostalCodes .Worksheets("Passive") 'Last row determined by vals in col A End With End Sub 

---

 Public Sub ConsolidatePostalCodes(ByRef wsD As Worksheet) Const COL_A = "A" Const COL_K = 11 Dim wsC As Worksheet, wsO As Worksheet, i As Long, t As Double Dim lrD As Long, lrC As Long, lrO As Long, maxRows As Long t = Timer maxRows = Rows.Count With Application.ThisWorkbook Set wsC = .Worksheets("NYorkPstlCode") 'Criteria Set wsO = .Worksheets("Consolidated") 'Output End With Application.ScreenUpdating = False If wsD.AutoFilterMode Then wsD.UsedRange.AutoFilter lrD = wsD.Cells(maxRows, COL_A).End(xlUp).Row lrC = wsC.Cells(maxRows, COL_A).End(xlUp).Row lrO = wsO.Cells(maxRows, COL_A).End(xlUp).Row + 1 For i = 2 To lrC With wsD With .UsedRange .AutoFilter Field:=COL_K, Criteria1:=wsC.Cells(i, COL_A).Value2 .Resize(.Rows.Count - 1).Offset(1).Copy wsO.Cells(lrO, COL_A) End With lrO = wsO.Cells(maxRows, COL_A).End(xlUp).Row + 1 End With Next wsD.UsedRange.AutoFilter Application.ScreenUpdating = True Debug.Print "Time: " & Format(Timer - t, "#,##0.000") & " sec" End Sub 

---