我對 VBA 相當陌生，并且正在苦苦思索如何將這兩個 subs 合并為一個，因為我需要為兩個單獨的 Pivot 啟用動態過濾器。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("L3:L4")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Summary").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Machine")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
與此結合
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("P16:P17")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Summary").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Machine")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
感謝您的幫助，謝謝！
uj5u.com熱心網友回復：
而不僅僅是退出，如果沒有交集，翻轉過來，并繼續進行，如果有是一個交集。
你的代碼，連同其他一些改進一起重構
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Application.ScreenUpdating = False
If Target.CountLarge > 1 Then
' User changed >1 cells. What now?
Exit Sub
End If
' On Error Resume Next <~~ don't do this globally!
If Not Intersect(Target, Me.Range("L3:L4")) Is Nothing Then
On Error Resume Next '<~~ Keep it tight around a potential error
' If the Change event is on Sheet Summary, use Me instead
Set xPTable = Me.PivotTables("PivotTable1")
' If the Change Event is NOT on Sheet Summary, be explicit on the workbook
'Set xPTable = Me.Parent.Worksheets("Summary").PivotTables("PivotTable1")
On Error GoTo 0
ElseIf Not Intersect(Target, Me.Range("P16:P17")) Is Nothing Then
On Error Resume Next
Set xPTable = Me.PivotTables("PivotTable2")
On Error GoTo 0
End If
If Not xPTable Is Nothing Then
On Error Resume Next '<~~ in case Machine doesn't exist
Set xPFile = xPTable.PivotFields("Machine")
On Error GoTo 0
If Not xPFile Is Nothing Then
xStr = Target.Value ' .Text is dangerous. Eg it can truncate if the column is too narrow
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
End If
End If
Application.ScreenUpdating = True
End Sub
uj5u.com熱心網友回復：
我認為重構有更多選擇。
將基本例程放入模塊中的單獨子程式中。然后可以從兩個作業表的 _change-events 中呼叫這個 sub。優點：如果你想改變子的邏輯 - 你在一個地方做，而不是兩個。或者可能會有第三張表想要使用相同的邏輯。（DRY原則：不要重復自己）
on error resume next如果有必要，我喜歡“外部化”到 tryGet 函式中。從而最大限度地降低其使用風險（在這種情況下是可以的）
這是基于 chris neilsens 建議以及來自 VBasic2008 的評論的通用子
也許您調整子的名稱以更精確地實作您想要實作的目標。
Public Sub handleMachineField(Target As Range, RangeToCheck As Range, PTName As String)
On Error GoTo err_handleMachineField
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Application.ScreenUpdating = False
If Target.CountLarge > 1 Then
' User changed >1 cells. What now?
Exit Sub
End If
If Not Intersect(Target, RangeToCheck) Is Nothing Then
Set xPTable = tryGetPivotTable(Target.Parent, PTName)
End If
If Not xPTable Is Nothing Then
Set xPFile = tryGetPivotField(xPTable, "Machine")
If Not xPFile Is Nothing Then
xStr = Target.Value ' .Text is dangerous. Eg it can truncate if the column is too narrow
Application.EnableEvents = False
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.EnableEvents = True
End If
End If
exit_handleMachineField:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
err_handleMachineField:
MsgBox Err.Description
Resume exit_handleMachineField
End Sub
Public Function tryGetPivotTable(ws As Worksheet, PTName As String) As PivotTable
'in case pivot table does not exist no error is thrown
'calling sub has to check for nothing instead
On Error Resume Next
Set tryGetPivotTable = ws.PivotTables(PTName)
On Error GoTo 0
End Function
Public Function tryGetPivotField(pt As PivotTable, FieldName As String) As PivotField
'in case field does not exist no error is thrown
'calling sub has to check for nothing instead
On Error Resume Next
Set tryGetPivotField = pt.PivotFields(FieldName)
On Error GoTo 0
End Function
這就是您從作業表事件中呼叫它的方式：
Private Sub Worksheet_Change(ByVal Target As Range)
handleMachineField Target, Me.Range("L3:L4"), "PivotTable1"
End Sub
順便說一句：這是將支票放入 sub 的另一個優點。在閱讀更改事件中的代碼時，您會立即知道會發生什么——您不必通讀所有代碼行來了解正在發生的事情。
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/335742.html