Question

如何更改用于选择XL pivotTable

中的页面项的代码

Dim pvtSM1 As PivotTable
Dim pviSM1 As PivotItem
Dim pvfSM1 As PivotField

Set pvtSM1 = ActiveSheet.PivotTables("SM1")

' set Pivot field variable to "RESULT"
Set pvfSM1 = pvtSM1.PivotFields("RESULT")
 ' loop through all Pivot Items in "RESULT" Pivot Field
    For Each pviSM1 In pvfSM1.PivotItems
        Select Case pviSM1.Name
            Case "4K2..00", "4K21.00", "4K22.00", "4K23.00", "4K41.00", "4K42.00", "4K43.00", "4KA1.00", "4KA2.00"
                pviSM1.Visible = True
            Case Else
                pviSM1.Visible = False
        End Select
    Next pviSM1
End With

...成为一个喜欢＆＃34; 4K2 *＆＃34;，＆＃34; 4K4 *＆＃34;，＆＃34; 4KA *＆＃34;

为了节省我添加所有确切代码

Answer 1

Dim pvtSM1 As PivotTable
Dim pviSM1 As PivotItem
Dim pvfSM1 As PivotField

我发誓，在我弄清楚它们之间的[单一字符]差异之前，我已经读了5遍（好吧，3）。我不知道SM1可能代表什么。建议：

Dim pvtTable As PivotTable
Dim pvtItem As PivotItem
Dim pvtField As PivotField

使用有意义的名字，你可以大声朗读，而不会像Ewok那样听起来。

更好的建议 - 将变量声明到更接近你使用它们的位置，而不是在程序顶部的声明墙中;然后使用Comintern's suggestion完全删除Select Case块：

Dim pvtTable As PivotTable
Set pvtTable = MyPivotTableSheet.PivotTables("SM1") ' don't assume what the ActiveSheet is

Dim pvtField As PivotField
Set pvtField = pvtTable.PivotFields("RESULT")

Dim pvtItem As PivotItem
For Each pvtItem In pvtField.PivotItems
    pvtItem.Visible = pvtItem.Name Like "4K[24A]*"
Next

哎呀，命名很难 - 不要为每个类型命名，按照目的命名。

如果PivotTables("SM1")不存在，或者PivotFields("RESULT")没有引用任何内容，则代码会引发运行时错误。避免这种情况的最好方法是将关注点分成小的，专门的函数，这些函数可以完成一件事并做得很好：

Private Function FindPivotTable(ByVal sheet As Worksheet, ByVal name As String) As PivotTable

    If sheet Is Nothing Then Err.Raise 5, "FindPivotTable", "'sheet' argument cannot be Nothing"

    On Error Resume Next
    Dim result As PivotTable
    Set result = sheet.PivotTables(name)
    On Error GoTo 0
    Err.Clear
    If result Is Nothing Then
        Err.Raise 9, "FindPivotTable", "Could not locate pivot table '" & name & "' on worksheet '" & sheet.Name & "'."
        Exit Function
    End If
    Set FindPivotTable = result
End Function

Private Function FindPivotField(ByVal pivot As PivotTable, ByVal name As String) As PivotField

    If pivot Is Nothing Then Err.Raise 5, "FindPivotField", "'pivot' argument cannot be Nothing"

    On Error Resume Next
    Dim result As PivotField
    Set result = pivot.PivotFields(name)
    On Error GoTo 0
    Err.Clear
    If result Is Nothing Then
        Err.Raise 9, "FindPivotField", "Could not locate pivot field '" & name & "' in pivot table '" & pivot.Name & "'."
        Exit Function
    End If
    Set FindPivotField = result
End Function

现在你的程序可以专注于它的任务，你可以重用这些专门的函数，而不是编写容易出错的错误代码，或者一遍又一遍地复制粘贴相同的故障安全代码：

    On Error GoTo ErrHandler

    Dim sourcePivot As PivotTable
    Set sourcePivot = FindPivotTable(MyPivotTableSheet, "SM1")
    If sourcePivot Is Nothing Then Exit Sub

    Dim resultField As PivotField
    Set resultField = FindPivotField(sourcePivot, "RESULT")
    If resultField Is Nothing Then Exit Sub

    Dim item As PivotItem
    For Each item In resultField.PivotItems
        item.Visible = item.Name Like "4K[24A]*"
    Next

    Exit Sub
ErrHandler:
    MsgBox "Error in '" & Err.Source & "': " & Err.Description

......但它仍然感觉臃肿，所以我会接受并参数化它，以便它可以解决targetField - 因为它应该是“结果”，我将调用参数{ {1}}：

resultField

现在，调用者有责任弄清Private Sub SetItemVisibilityByPattern(ByVal resultField As PivotField, ByVal likePattern As String) If resultField Is Nothing Then Exit Sub Dim item As PivotItem For Each item In resultField.PivotItems item.Visible = item.Name Like likePattern Next End Sub如何到达那里，并且你只需要一个非常非常简单的程序来完成一件事。

resultField适用于基本模式搜索。当您开始需要更复杂的模式（例如匹配“4K2 *”但也匹配“685 *”）时，请考虑使用正则表达式模式（此处引用 Microsoft VBScript正则表达式5.5 < / em> library）：

Like

使用单个正则表达式模式，您可以根据需要匹配任何您喜欢的内容：

Private Sub SetItemVisibilityByPattern(ByVal resultField As PivotField, ByVal regexPattern As String) If resultField Is Nothing Then Exit Sub With New RegExp .Pattern = regexPattern Dim item As PivotItem For Each item In resultField.PivotItems item.Visible = .Execute(item.Name).Count > 0 Next End With End Sub

Answer 2

如果你真的希望select case与like这里的笨重的例子：

Sub test()
    Dim str As String

    str = InputBox("feed me a string")

    Select Case str Like "4K[24A]*"
        Case True
            Call MsgBox("Da!")
            'pviSM1.Visible = True
        Case False
            Call MsgBox("Net!")
            'pviSM1.Visible = false
    End Select
End Sub

VBA更改Case以查找LIKE字符串

2 个答案: