Question

我正在尝试过滤数据并将其传输到另一张表，我已经看到了传输数据的示例，但标准只是1.我需要设置5个条件并过滤5个不同的字段。每当我尝试输入 xlAutoFilterOperator = xlAnd 时，我的语法都有问题，请帮我纠正。

Sub FilterTransfer()

Dim sh As Worksheet, ws As Worksheet
Dim var As Variant
Dim var1 As Variant
Dim var2 As Variant
Dim var3 As Variant
Dim var4 As Variant
Dim var5 As Variant
Dim var6 As Variant
Dim sub1 As Variant
Dim sub2 As Variant
Dim sub3 As Variant
Dim sub4 As Variant
Dim acc1 As Variant
Dim acc2 As Variant
Dim acc3 As Variant
Dim acc4 As Variant

var = "F"
var1 = "Kaz"
var2 = "COS - Jessie"
var3 = "INM - Jessie"
var4 = "Jimmy"
var5 = "Belinda"
var6 = "Critical"
sub1 = "Yes"
sub2 = "No"
sub3 = "With Dependency"
sub4 = "TBD"
acc1 = "Yes"
acc2 = "No"
acc3 = "With Dependency"
acc4 = "TBD"


Set sh = Worksheets("Raw Data") 'set the sheet to filter
Set ws = Worksheets("Sheet1") 'set the sheet to paste
ws.Range("AD1", ws.Cells(ws.Rows.Count, "A").End(xlUp)).ClearContents '<--| clear "paste" sheet columns A:L cells from row 1 down to column A last not empty one

Application.ScreenUpdating = False

With sh '<--| reference your "copy" sheet
    With .Range("AD1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:L cells from row 1 down to column A last not empty cell
        .AutoFilter Field:=2, Criteria1:=var 'filter on referenced range 9th column with 'var'
       .AutoFilter Field:=5, Criteria1:=var6
       .AutoFilter Field:=3, Criteria1:=var1, Criteria2:=var2, xlAutoFilterOperator= xlAnd, Criteria3:=var3, Criteria4:=var4, Criteria5:=var5
        .AutoFilter Field:=16, Criteria1:=sub1, Criteria2:=sub2, xlAutoFilterOperator= xlAnd, Criteria3:=sub3, Criteria4:=sub4
       .AutoFilter Field:=21, Criteria1:=acc1, Criteria2:=acc2, xlAutoFilterOperator= xlAnd, Criteria3:=acc3, Criteria4:=acc4



        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) '<--| if any cell filtered other than headers (which get always filtered) then copy filtered values to "paste" sheet
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True

End Sub

Answer 1

您可以使用AutoFilter利用其xlFilterValues参数并传递过滤器值数组，如下所示：

Sub FilterTransfer()

    Dim sh As Worksheet, ws As Worksheet
    Dim var As Variant, var6 As Variant
    Dim filters1 As Variant, filters2 As Variant

    var = "F"
    var6 = "Critical"
    filters1 = Array("F", "Kaz", "COS - Jessie", "INM - Jessie", "Jimmy")
    filters2 = Array("Yes", "No", "With Dependency", "TBD")



    Set sh = Worksheets("Raw Data") 'set the sheet to filter
    Set ws = Worksheets("Sheet01") 'set the sheet to paste
    ws.Range("AD1", ws.Cells(ws.Rows.Count, "A").End(xlUp)).ClearContents '<--| clear "paste" sheet columns A:L cells from row 1 down to column A last not empty one

'    Application.ScreenUpdating = False

    With sh '<--| reference your "copy" sheet
        With .Range("AD1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its columns A:L cells from row 1 down to column A last not empty cell
            .AutoFilter Field:=2, Criteria1:=var 'filter on referenced range 9th column with 'var'
            .AutoFilter Field:=5, Criteria1:=var6
            .AutoFilter Field:=3, Criteria1:=filters1, Operator:=xlFilterValues
            .AutoFilter Field:=16, Criteria1:=filters2, Operator:=xlFilterValues
            .AutoFilter Field:=21, Criteria1:=filters2, Operator:=xlFilterValues

            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) '<--| if any cell filtered other than headers (which get always filtered) then copy filtered values to "paste" sheet
        End With
        .AutoFilterMode = False
    End With

'    Application.ScreenUpdating = True

End Sub

如果您想移动“数据，只需更改此代码段：

        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
            .SpecialCells(xlCellTypeVisible).Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) '<--| if any cell filtered other than headers (which get always filtered) then copy filtered values to "paste" sheet
            .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '
        End If

VBA代码根据MULTIPLE标准过滤数据并传输到其他工作表

1 个答案: