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*"
为了节省我添加所有确切的代码
Run Code Online (Sandbox Code Playgroud)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
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)