Ошибка 1004 произошла из-за использования квадратных скобок []. Удалить те.
Вам также необходимо использовать ключевое слово Set, когда вы устанавливаете объект, равный чему-либо. Например Set MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.[P_ID").DataRange.
Если вы не используете Set, вы получите диалоговое окно с ошибкой во время выполнения VBA, которое сообщает Ошибка во время выполнения '91': переменная объекта или переменная блока не установлена
Я не могу гарантировать, что мои изменения полностью решат вашу проблему, поскольку у меня нет ваших данных и я не могу полностью протестировать ваш код. Вам нужно будет использовать режим отладки в редакторе VBA и один шаг по коду. Для этого установите точку останова на Set mDataRange = Active.... Чтобы установить точку останова, перейдите в меню «Отладка» и выберите пункт подменю «Переключить точку останова», или вы можете нажать F9, чтобы установить точку останова.
Теперь, когда вы вносите изменения в сводную таблицу, событие Worksheet_PivotTableUpdate сработает, и в этот момент код превысит выполнение.
После того, как код перестает выполняться из-за точки останова, вы можете нажать клавишу F8, чтобы выполнить пошаговый просмотр кода. Если вы хотите возобновить выполнение до следующей точки останова, вы можете нажать F5. Также, когда вы получаете диалоговое окно с ошибкой VBA, вы можете нажать Отладка, а затем использовать клавишу F8 для одного шага или использовать окна отладки, чтобы увидеть, что содержат ваши переменные и объекты. Я уверен, что есть несколько хороших видео на YouTube по отладке VBA.
По мере того, как вы шагаете по коду, вы можете наблюдать за тем, что содержит каждая переменная / объект, используя окно Immediate, окно Watches и окно Locals. Чтобы открыть эти окна, перейдите в пункт меню «Вид» и щелкните каждый из этих пунктов подменю.
Вот как вам нужно отредактировать код перед отладкой.
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Better practice is to not use the underscore character to
'continue a Dim declaration line
Dim mDataRange As Range
Dim ar As Range
Dim x As String
Dim y As String
Dim str As Variant
'Use Set to assign the object mDataRange a reference to the the right
'hand side of the equation. Remove the square brackets
'MyArray = ActiveSheet.PivotTables("PivotTable2").PivotFields("[ComparisonTable].[P_ID].[P_ID]").DataRange
Set mDataRange = ActiveSheet.PivotTables("PivotTable2").PivotFields("ComparisonTable.P_ID.P_ID").DataRange
For Each ar In mDataRange
'You need to specify what proprerty from ar you
'want to assign to x. Assuming the value stored in
'ar.Value2 is a string, this should work.
'We use value2 because it is the unformmated value
'and is slightly quicker to access than the Text or Value
'properties
'x = "[MasterTable].[P_ID].&[" & ar & "]"
x = "MasterTable.P_ID." & ar.Value2
'Once again specify the Value2 property as containing
'what value you want to test
If ar.Value2 <> "" And bFieldItemExists(x) = True Then
If str = "" Then
'Remove the square brackets and use the specific property
'str = "[MasterTable].[P_ID].&[" & ar & "]"
str = "MasterTable.P_ID." & ar.Value2
Else
'Remove the square brackets and use the specific property
'str = str & "," & "[MasterTable].[P_ID].&[" & ar & "]"
str = str & "," & "MasterTable.P_ID." & ar.Value2
End If
End If
Next ar
Dim str2() As String
str2 = Split(str, ",")
Application.EnableEvents = False
Application.ScreenUpdating = False
'Remove square brackets
'ActiveSheet.PivotTables("PivotTable1").PivotFields("[MasterTable].[P_ID].[P_ID]").VisibleItemsList = Array(str2)
ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").VisibleItemsList = Array(str2)
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Function bFieldItemExists(strName As String) As Boolean
'Declare a PivotItem to accept the return value
Dim pvItem As PivotItem
'Since you want to trap for an error, you'll need to let the VBA runtime know
'The following code is a pseudo Try/Catch. This tells the VBA runtime to skip
'the fact an error occured and continue on to the next statement.
'Your next statement should deal with the error condition
On Error Resume Next
'Use Set whenever assigning an object it's "value" or reference in reality
Set pvItem = ActiveSheet.PivotTables("PivotTable1").PivotFields("MasterTable.P_ID.P_ID").PivotItems(strName)
'Assuming that an error gets thrown when strName is not found in the pivot
'Err is the error object. You should access the property you wish to test
If Err.Number = 0 Then
bFieldItemExists = True
Else
bFieldItemExists = False
End If
'Return to normal error functioning
On Error GoTo 0
End Function
Наконец, я понимаю, что кое-что из этого должно быть в разделе комментариев, но мне нужно было объяснить слишком много, чтобы помочь Learner74. Но самое главное, я надеюсь, что помог ему. Я использовал так много предложений, рекомендаций и объяснений от обмена переполнения стека VBA в течение многих лет, я просто хочу вернуть его, заплатив вперед.
Дополнительные полезные ссылки:
Чип Пирсон - это сайт и человек для всех вещей VBA
Paul Kelly's Excel Macro Mastery - еще один переход на сайт по вопросам Excel и VBA.
Объектная модель Microsoft Excel , которая иногда полезна, но нуждается в улучшении. Слишком многим объектам не хватает примеров, но они могут, по крайней мере, указать вам правильное направление.