Question

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

我有一张带有400K记录的excel Master表

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

我必须从主表格复制记录，如果字段＆＃34; K＆＃34;有这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() 复制来自＆＃34; Active＆＃34;的过滤数据和被动＆＃34;被动＆＃34;表格为＆＃34;合并＆＃34;

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

使用“高级”过滤器在单独的工作表中复制数

1 个答案: