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

Question

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

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

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

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

数据下拉列是一个带有下拉列表的单元格，VLOOKUP用于填充两列参考单元格。这是需要过滤的两列。

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

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

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

我有一段代码试图从这里修改

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部分以满足我的需要（即 Column I <>"X" and column J=F2

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

组合表示例

---

更新

所以由于这个线程，我的代码现在看起来像这样

    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 窗口运行代码，它将无错误地运行。

任何人都可以对这些问题有所了解吗？

标签： excelvba