VBA更改Case以查找LIKE字符串

Bra*_*eyS 0 excel vba excel-vba

如何更改用于在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
Run Code Online (Sandbox Code Playgroud)

......变成像"4K2*","4K4*","4KA*"

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

Mat*_*don 8

Dim pvtSM1 As PivotTable
Dim pviSM1 As PivotItem
Dim pvfSM1 As PivotField
Run Code Online (Sandbox Code Playgroud)

我发誓,在我弄清楚它们之间的[单字符]差异之前,我已经读了5遍(好吧,3).我不知道什么SM1可能代表什么.建议:

Dim pvtTable As PivotTable
Dim pvtItem As PivotItem
Dim pvtField As PivotField
Run Code Online (Sandbox Code Playgroud)

使用有意义的名字,你可以大声朗读,而不会听起来像Ewok.

更好的建议 - 将变量声明到更接近你使用它们的位置,而不是在程序顶部的声明墙中; 然后使用Comintern的建议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
Run Code Online (Sandbox Code Playgroud)

而且,命名很难 - 不要根据他们的类型命名,根据他们的目的命名.

如果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
Run Code Online (Sandbox Code Playgroud)

现在,您的过程可以专注于其任务,您可以重用这些专用函数,而不是编写容易出错的代码,或者反复粘贴相同的故障安全代码:

    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
Run Code Online (Sandbox Code Playgroud)

...但它仍然感觉臃肿,所以我采取它并参数化它,以便它的工作targetField- 因为它应该是"结果",我将调用参数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
Run Code Online (Sandbox Code Playgroud)

而现在,调用者有责任弄清楚如何resultField到达那里,并且你只需要一个非常非常简单的程序就能完成一件事.


Like适用于基本模式搜索.当您开始需要更复杂的模式(例如匹配"4K2*"但也"685*")时,请考虑使用正则表达式模式(此处引用Microsoft VBScript Regular Expressions 5.5库):

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
Run Code Online (Sandbox Code Playgroud)

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

SetItemVisibilityByPattern(resultField, "(4K[24A]|685|923).*")
Run Code Online (Sandbox Code Playgroud)

  • 天哪,当我发布SO答案时,我需要停止"[codereview.se]模式". (6认同)