VBA代码根据条件过滤数据并将数据传输到其他工作表

时间:2017-04-04 05:48:26

标签: vba excel-vba excel

我正在尝试通过比较PDF值= 1.4来过滤I列中的数据,即PDF版本,并且过滤数据需要复制到Sheet1中。 在这里我得到错误,因为运行时错误-424对象需要

Sub FilterMe()

    Dim sh As Worksheet, ws As Worksheet
    Dim LstR As Long, rng As Range
    Dim var As Variant
    Dim myWb As Excel.Workbook

    Set myWb = ActiveWorkbook

    var = 1.4

    Sheets("Sheet1").Range("A1:L20").ClearContents

    Set sh = Sheets("DataSheet")    'set the sheet to filter
    Set ws = Sheets("Sheet1")    'set the sheet to paste

    Application.ScreenUpdating = False

    With sh    'do something with the sheet

        LstR = .Cells(.Rows.Count, "I").End(xlUp).Row    'find last row

        .Columns("I:I").AutoFilter Field:=9, Criteria1:=PDF.var 'ERROR coming here

        Set rng = .Range("A1:I" & LstR).SpecialCells(xlCellTypeVisible)    

        rng.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
        .AutoFilterMode = False

    End With

End Sub

2 个答案:

答案 0 :(得分:0)

什么是Criteria1:= PDF.var?

同样,在过滤单个列时,该字段应始终为1。

.Columns("I:I").AutoFilter Field:=1, Criteria1:=var

答案 1 :(得分:0)

您可能希望采用这一点(注释)重构代码:

Sub FilterMe()
    Dim sh As Worksheet, ws As Worksheet
    Dim var As Variant

    var = 1.4

    Set sh = Worksheets("DataSheet") 'set the sheet to filter
    Set ws = Worksheets("Sheet1") 'set the sheet to paste
    ws.Range("L1", 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("I1", .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:=9, Criteria1:=var '<--| filter on referenced range 9th column with 'var'
            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