Excel VBA - 使用命名范围的自定义过滤器

Question

我在工作表上有一列数据，包含在我正在处理的非常大的工作簿中，名为Vendor，我想在VBA中编写一个宏，允许我按特定供应商进行过滤，说Vendor A。

到目前为止，我有这个：

Sub filterVendor()
'
' filterVendor Macro
'

'
    ActiveSheet.Range("$A:$BB").AutoFilter Field:=21, Criteria1:= _
        "Vendor A"

End Sub

我遇到的问题是Vendor列的位置可能会发生变化 - 因为在其之前添加和/或删除了其他列，导致它相应地移动 - 我想知道是否可能引用这个特定的列/数据块来保存宏变得无用。

理想情况下，我会引用范围（vendor是我想要命名的范围），这样，无论工作表的结构发生了什么，过滤器在宏时都会正常工作跑了。

如何做到这一点？

更多信息：

我怀疑Field:条件导致了问题，因为这似乎绝对定义了要过滤的列;即使我已指定Vendor列被命名为vendor作为命名范围，即使命名范围引用与所述Vendor列一起移动，过滤的列总是位于在Field:中指定的位置。如何解决这个问题以便按照我想要的方式工作？

我试过了：

...Field:=Range("vendor")

和

...Field:=(Range("vendor"))

但这两个都会导致错误。

Answer 1

Autofilter 喜欢基于单一的单维数组，因此我们构建并应用这种类型的数组：

Sub FilterMyData()
    Dim ary(), N As Long, i As Long

    N = Range("Vendors").Count
    ReDim ary(1 To N)
    For i = 1 To N
        ary(i) = Range("Vendors")(i).Value
    Next i

    With ActiveSheet.Range("A:BB")
        .AutoFilter Field:=23, Criteria1:=ary, Operator:=xlFilterValues
    End With
End Sub

Answer 2

有趣的挑战！我通过以下方式解决了这个问题：

• 使用名为Range，＆＃34;供应商＆＃34;，如您所述（我认为）
• 编写一个小帮助函数DoesVendorExist，确保名为Range＆＃34;供应商＆＃34;存在
• 编写另一个小辅助函数VendorColNum，它返回＆＃34;供应商＆＃34;
的列号
• 根据.Autofilter
返回的号码应用VendorColNum

以下是我测试的（通常很小的）工作簿的屏幕截图：

以下是辅助函数和稍微修改过的filterVendor2子例程：

Option Explicit
Sub filterVendor2()

Dim DataSheet As Worksheet
Dim VendorCol As Long

'set references up-front
Set DataSheet = ThisWorkbook.Worksheets("data")

'...
'doing other stuff
'...

'here we make sure a named range called Vendor exists
If Not DoesVendorExist(ThisWorkbook) Then
    MsgBox ("Dangit! There is not a named range Vendor in this workbook! Exiting...")
    Exit Sub
End If

'define the vendor column
VendorCol = VendorColNum(DataSheet)

'here we make sure the Vendor named range is not empty
If VendorCol = 0 Then
    MsgBox ("Bummer! The named range Vendor was Nothing on DataSheet, exiting...")
    Exit Sub
End If

'otherwise, let's do some filtering!
DataSheet.Range("$A:$BB").AutoFilter Field:=VendorCol, Criteria1:="SnookerFan"

'...
'doing other cool stuff and finishing up
'...

End Sub

'INPUT  : pass this function the worksheet on which the Vendor range is defined
'OUTPUT : the column number that the Vendor range exists in
'SPECIAL: if the Vendor Range is nothing, return 0
Public Function VendorColNum(Sheet As Worksheet) As Long

'if the Vendor range is missing, return 0 and exit
If Sheet.Range("Vendor") Is Nothing Then
    VendorColNum = 0
    Exit Function
End If

'otherwise, we return a real column number
VendorColNum = Sheet.Range("Vendor").Column

End Function

'INPUT  : pass this function the workbook we'd like to check for Vendor
'OUTPUT : true/false... does Vendor exist?
'SPECIAL: none
Public Function DoesVendorExist(Book As Workbook) As Boolean

Dim Nm As Name

'assume false, test each name and flip the flag if Vendor is found
'assume false, test each name and flip the flag if Vendor is found
DoesVendorExist = False
For Each Nm In Book.Names
    If UCase(Nm.Name) = UCase("vendor") Then '<~ error was here, did not paste over .Name
        DoesVendorExist = True
        Exit Function
    End If
Next Nm

End Function

最后，这是结果过滤的Range。您应该会发现在数据表中添加或删除列不会破坏代码。

编辑：我很抱歉，因为我自己解决了这个问题时检查指定范围的错误是一个草率的复制/粘贴。我已更新上面的代码并突出显示错误（正在检查Nm以查看它是否匹配＆＃34;供应商＆＃34;，应该检查Nm.Name以查看它是否与{{1}匹配}。

Answer 3

您使用的是MS Excel 2010版吗？如果是这样，您可以使用内置过滤器选项，该选项可以临时使用。

首先，您需要形成一个表..然后只需单击过滤器箭头。