Question

我有一个名为“组合”的表，该表存储在工作簿的一张纸上。

在第二张纸上，我具有以下单元格范围（在C1:F2中）

Delivery    | Column Ref | Column Ref | Available
Delivery ID | I          | J          | YES

我希望能够使用VBA根据此单元格区域中的值过滤表

“数据”下拉列是具有下拉列表的单元格，该列表使用VLOOKUP填充两个列引用单元格。这是需要过滤的两列。

第I列需要显示<>"X"的所有行，而第J列则需要显示等于可用列中值的所有行。

然后，我需要能够将列A，G和出现在第一个参考单元格中的列复制到第二张工作表中的单元格A5。

是否可以使用VBA做到这一点？我一直在尝试使用IF语句来执行此操作，但这非常混乱。

我有一段代码正在尝试修改from here

Sub Sample()
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim rRange As Range, rngToCopy As Range
    Dim lRow As Long    
    Dim lRow2 As Long
    Dim lCol As Long

    'Find the last non-blank cell in column A(1)
    lRow2 = Cells(Rows.Count, 1).End(xlUp).Row

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Combined")

    With ws

        '~~> Set your range for autofilter
        Set rRange = .Range("A1:AR" & lRow2)

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> Filter, copy visible rows to temp sheet
        With rRange
            .AutoFilter Field:=9, Criteria1:="X"

            '~~> This is required to get the visible range
            ws.Rows("1:lRow2").EntireRow.Hidden = True

            Set rngToCopy = .SpecialCells(xlCellTypeVisible).EntireRow

            Set wsTemp = Sheets.Add

            rngToCopy.Copy wsTemp.Range("A1")

            '~~> Unhide the rows
            ws.Rows("1:lRow").EntireRow.Hidden = False
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With

    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
End Sub

但是我不知道如何修改With rRange部分以满足我的需要（即，列I <>“ X”和列J = F2

另外，此行ws.Rows("1:lRow2").EntireRow.Hidden = True给了我一个类型不匹配的错误

example of combined table

更新

感谢this thread

，现在我的代码看起来像这样

    Sub AddFilter()
'
' AddFilter Macro
'

Dim rCrit1 As Range, rCrit2 As Range, rCrit3 As Range
Dim copyRange1 As Range, copyRange2 As Range, copyRange3 As Range
Dim filterRange As Range
Dim lastRow As Long

Set src = ThisWorkbook.Sheets("Combined")
Set tgt = ThisWorkbook.Sheets("Dashboard")

lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
Set filterRange = src.Range("A1:Z" & lastRow)
Set copyRange1 = src.Range("A2:A" & lastRow)
Set copyRange2 = src.Range("G2:G" & lastRow)
Set copyRange3 = src.Range("I2:I" & lastRow)

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rCrit1 = Worksheets("Dashboard").Range("Ref_1")
Set rCrit2 = Worksheets("Dashboard").Range("Ref_2")
Set rCrit3 = Worksheets("Dashboard").Range("Ref_3")

Sheets("Dashboard").Range("A1:C3").ClearContents
Sheets("Dashboard").Range("A1:C3").ClearFormats

Selection.AutoFilter
filterRange.AutoFilter Field:=rCrit1, Criteria1:="<>X"
filterRange.AutoFilter Field:=rCrit2, Criteria1:=rCrit_3

copyRange1.SpecialCells(xlCellTypeVisible).Copy tgt.Range("A5")
copyRange2.SpecialCells(xlCellTypeVisible).Copy tgt.Range("B5")
copyRange3.SpecialCells(xlCellTypeVisible).Copy tgt.Range("C5")

End Sub

但是filterRange.Autofilter行不能正确读取rCrit_3值，因此也不能基于此进行过滤（Ref_3是一个命名范围，在问题的第一部分包含YES单元格。）

另外，copyRange行给了我“ 1004”运行时错误，但是如果我最小化电子表格并从VBA窗口运行代码，它将运行无错误。

谁能在这些问题上阐明一些观点？

使用VBA过滤表并将某些列复制到新工作表

0 个答案: