こんにちはフランク
ソリーはそれであなたを助けることができません。

こんにちはジェリ、
申し訳ありませんがそれであなたを助けることはできません。 私たちのフォーラムに質問を投稿することを歓迎します： https://www.extendoffice.com/forum.html Excelの専門家や他のExcelファンからより多くのExcelサポートを取得します。

これらを見つけて、Array（）、Intersect（）、Worksheets（）、Pivo​​tFields（）で変更します

ピボットテーブル1
ピボットテーブル2
ピボットテーブル3
ピボットテーブル4
H1
シート名
フィールド名

Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub

こんにちはギルマーアルベス、
申し訳ありませんがそれであなたを助けることはできません。 私たちのフォーラムに質問を投稿することを歓迎します： https://www.extendoffice.com/forum.html Excelの専門家や他のExcelファンからより多くのExcelサポートを取得します。

こんにちは、
エラープロンプトが表示されましたか？ Excelのバージョンなど、問題についてより具体的に知る必要があります。 よろしければ、新しいワークブックでデータを作成してagaiを試すか、データのスクリーンショットを撮ってここにアップロードしてみてください。

こんにちはジャスティン、
エラープロンプトが表示されましたか？ 私はあなたの問題についてもっと具体的に知る必要があります。
コードを適用する前に、「シートの名前""ピボットテーブルの名前""ピボットテーブルのフィルターの名前" そしてその セル に基づいてピボットテーブルをフィルタリングします（sceenshotを参照）。

こんにちはクリスタル、

ご協力いただきありがとうございます。 問題は、関数が何らかの理由で何もしていないことです。 いくつかの説明：

ピボット名：Order_Comp_B2C
シート名：計算シート
フィルタ名：週番号（この名前をデータファイルの「ディスパッチ週番号」から変更しました）
変更するセル：O26およびO27（これは範囲内に収まるはずです）

このピボットでは、列のフィルターを変更しようとしています。[ピボットテーブルフィールド]メニューのフィルター領域には何もありません。

私のコードは次のとおりです。

プライベートサブワークシート_Change（ByValターゲットを範囲として）
'更新者 Extendoffice 20180702
xPTableをピボットテーブルとして薄暗くする
xPFileをPivotFieldとして薄暗くする
文字列としての薄暗いxStr
エラーで次の再開
Intersect（Target、Range（ "O26"））が何もない場合は、Subを終了します
Application.ScreenUpdating = False
xPTable = Worksheets（ "Calculation Sheet"）。PivotTables（ "Order_Comp_B2C"）を設定します
xPFile = xPTable.PivotFields（ "Week Number"）を設定します
xStr = ターゲット.テキスト
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Subの

おかげで、

ジャスティン

こんにちはジャスティンTeeuw、
私は変更しました ピボット名, シート名, フィルタ名 及び 変更するセル 上記の条件で、提供したVBAコードを試してみたところ、私の場合はうまく機能します。 次のGIFまたは添付のワークブックを参照してください。
新しいワークブックを作成して、コードを再試行してもよろしいですか？

こんにちはクリスタル、

ピボットのスクリーンショットを添付した赤いボックスは、セルの値に基づいて変更したいフィルターです。

できれば、複数の週番号を示すセルの範囲を使用したいと思います。

おかげで、

ジャスティン

こんにちはジャスティン、
申し訳ありませんが、ページに添付したスクリーンショットが表示されませんでした。 ページにエラーがある可能性があります。
それでも問題を解決する必要がある場合は、zxm@addin99.com経由で私にメールしてください。 ご不便おかけしてすみません。

こんにちはジャスティンTeeuw、
次のVBAコードを試してください。 私が助けることができることを願っています。

Private Sub Worksheet_Change(ByVal Target As Range)
    'Update by Extendoffice 20220706
    Dim I As Integer
    Dim xFilterStr1, xFilterStr2 As String
    On Error Resume Next
    If Intersect(Target, Range("O26:O27")) Is Nothing Then Exit Sub
    'Application.ScreenUpdating = False
    
    xFilterStr1 = Range("O26").Value
    xFilterStr2 = Range("O27").Value
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        ClearAllFilters
    If xFilterStr1 = "" And xFilterStr2 = "" Then Exit Sub
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        EnableMultiplePageItems = True
    xCount = ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems.Count

    For I = 1 To xCount
        If I <> xFilterStr1 And I <> xFilterStr2 Then
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = False
        Else
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = True
        End If
    Next

    'Application.ScreenUpdating = True
End Sub

こんにちはmaziaritib4TIB、
この方法は、MicrosoftExcelでのみ使用できます。 ご不便おかけしてすみません。

こんにちはジェームズ、

はい、これは可能です。これに使用したコードは（4つのピボットと2つのセル参照）です。

プライベートサブワークシート_Change（ByValターゲットを範囲として）
Dim I As Integer
Dim xFilterStr1、xFilterStr2、yFilterstr1、yfilterstr2 As String
エラーで次の再開
Intersect（Target、Range（ "O26：P27"））が何もない場合は、Subを終了します

xFilterStr1 = Range（ "O26"）。Value
xFilterStr2 = Range（ "O27"）。Value
yFilterstr1 = Range（ "p26"）。Value
yfilterstr2 = Range（ "p27"）。Value
ActiveSheet.PivotTables（ "Order_Comp_B2C_Crea"）。PivotFields（ "週番号"）。 _
ActiveSheet.PivotTables（ "Order_Comp_B2B_Crea"）。PivotFields（ "週番号"）。 _
ActiveSheet.PivotTables（ "Order_Comp_B2C_Disp"）。PivotFields（ "週番号"）。 _
ActiveSheet.PivotTables（ "Order_Comp_B2B_Disp"）。PivotFields（ "週番号"）。 _
ClearAllFilters

xFilterStr1 = "" And xFilterStr2 = "" And yFilterstr1 = "" And yfilterstr2 = ""の場合、Subを終了します
ActiveSheet.PivotTables（ "Order_Comp_B2C_Crea"）。PivotFields（ "週番号"）。 _
ActiveSheet.PivotTables（ "Order_Comp_B2B_Crea"）。PivotFields（ "週番号"）。 _
ActiveSheet.PivotTables（ "Order_Comp_B2C_Disp"）。PivotFields（ "週番号"）。 _
ActiveSheet.PivotTables（ "Order_Comp_B2B_Disp"）。PivotFields（ "週番号"）。 _
EnableMultiplePageItems = True

xCount = ActiveSheet.PivotTables（ "Order_Comp_B2C_Crea"）。PivotFields（ "Week Number"）。PivotItems.Count
xCount = ActiveSheet.PivotTables（ "Order_Comp_B2B_Crea"）。PivotFields（ "Week Number"）。PivotItems.Count
yCount = ActiveSheet.PivotTables（ "Order_Comp_B2C_Disp"）。PivotFields（ "Week Number"）。PivotItems.Count
yCount = ActiveSheet.PivotTables（ "Order_Comp_B2B_Disp"）。PivotFields（ "Week Number"）。PivotItems.Count

I=1からxCountの場合
もし私が<>xFilterStr1そして私が<>xFilterStr2なら
ActiveSheet.PivotTables（ "Order_Comp_B2C_Crea"）。PivotFields（ "Week Number"）。PivotItems（I）.Visible = False
ActiveSheet.PivotTables（ "Order_Comp_B2B_Crea"）。PivotFields（ "Week Number"）。PivotItems（I）.Visible = False
他
ActiveSheet.PivotTables（ "Order_Comp_B2C_Crea"）。PivotFields（ "Week Number"）。PivotItems（I）.Visible = True
ActiveSheet.PivotTables（ "Order_Comp_B2B_Crea"）。PivotFields（ "Week Number"）。PivotItems（I）.Visible = True
終了する場合
次へ

I=1からyCountの場合
もし私が<>yFilterstr1そして私が<>yfilterstr2なら
ActiveSheet.PivotTables（ "Order_Comp_B2C_Disp"）。PivotFields（ "Week Number"）。PivotItems（I）.Visible = False
ActiveSheet.PivotTables（ "Order_Comp_B2B_Disp"）。PivotFields（ "Week Number"）。PivotItems（I）.Visible = False
他
ActiveSheet.PivotTables（ "Order_Comp_B2C_Disp"）。PivotFields（ "Week Number"）。PivotItems（I）.Visible = True
ActiveSheet.PivotTables（ "Order_Comp_B2B_Disp"）。PivotFields（ "Week Number"）。PivotItems（I）.Visible = True
終了する場合
次へ

End Subの

こんにちはST、
ターゲット値がH6にあり、D18の値に応じて変化するとします。 このターゲット値に基づいてピボットテーブルをフィルタリングします。 次のVBAコードが役立ちます。 ぜひお試しください。

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/07/22
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("h6")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub

Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("Pivot Table 1")
Set xPFile = xPTable.PivotFields("Category")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub

こんにちはST、
私はあなたが何を意味するのかよくわかりません。 あなたの場合、ターゲットセルD3の値は、ピボットテーブルをフィルタリングするために使用されます。 ターゲットセルD3の数式は、セルA15、B15、およびC15の値を参照します。これらの値は、参照セルの値に応じて変化します。 A15、B15、およびC15のいずれかの値が変更された場合、ターゲットセルの値がピボットテーブルのフィルター条件を満たしていれば、ピボットテーブルは自動的にフィルター処理されます。 ターゲットセルの値がピボットテーブルのフィルタリング基準を満たさない場合、ピボットテーブルは自動的にフィルタリングなしにリセットされます。

Sagar T さん、こんにちは。
コードが更新されました。 ぜひお試しください。 ご意見をいただきありがとうございます。
ワークシート、ピボット テーブル、およびコード内のフィルターの名前を変更することを忘れないでください。 または、次のアップロードされたワークブックをテスト用にダウンロードできます。

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220805
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("D3")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub
xStr = Format(xRg.Text, "m/d/yyyy")
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet2").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Date")
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub

こんにちは。

このコメントの VBA コードかどうかを確認してください #38754 助けることができる。

こんにちは。

コードを変更する必要はありません。参照するセルのワークシートに VBA コードを追加するだけです。
たとえば、「ピボットテーブル1"で Sheet2 セルの値に基づく H6 in Sheet3、右クリックしてください Sheet3 ワークシート タブで、 コードを表示 右クリック メニューから、コードを Sheet3 (コード) 窓。