excel - 使用高级过滤器将数据复制到单独的工作表中

Question

我想使用自动过滤器或高级过滤器进行过滤

我有一个 400K 记录的 excel 主表

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

如果字段“K”有这 31 个字母数字数据中的任何一个，我必须从主表中复制记录

我尝试了以下。那没起效。您的帮助将不胜感激。

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

子 ProcessWorkSheets() 将过滤后的数据从“Active”和“Passive”工作表复制到“Consolidated”

(如果 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