Note: The other languages of the website are Google-translated. Back to English

ピボットテーブルフィルターをExcelの特定のセルにリンクするにはどうすればよいですか?

ピボットテーブルフィルターを特定のセルにリンクし、セル値に基づいてピボットテーブルをフィルター処理する場合は、この記事の方法が役立ちます。

ピボットテーブルフィルターをVBAコードを使用して特定のセルにリンクする


ピボットテーブルフィルターをVBAコードを使用して特定のセルにリンクする

フィルタ関数をセル値にリンクするピボットテーブルには、フィルタフィールドを含める必要があります(フィルタフィールドの名前は、次のVBAコードで重要な役割を果たします)。

以下のピボットテーブルを例として取り上げます。ピボットテーブルのフィルターフィールドは次のように呼び出されます。 カテゴリー、およびXNUMXつの値が含まれています。経費"と"セールス」。 ピボットテーブルフィルターをセルにリンクした後、ピボットテーブルのフィルターに適用するセル値は「経費」と「売上」になります。

1.ピボットテーブルのフィルター機能にリンクするセル(ここではセルH6を選択)を選択し、フィルター値のXNUMXつを事前にセルに入力してください。

2.セルにリンクするピボットテーブルが含まれているワークシートを開きます。 シートタブを右クリックして、 コードを表示 コンテキストメニューから。 スクリーンショットを参照してください:

3。 の中に アプリケーション向け Microsoft Visual Basic ウィンドウで、以下のVBAコードをコードウィンドウにコピーします。

VBAコード:ピボットテーブルフィルターを特定のセルにリンクする

Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("H6")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Category")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

免責事項:

1) "Sheet1」は開いたワークシートの名前です。
2) "ピボットテーブル2」は、フィルター機能をセルにリンクするピボットテーブルの名前です。
3)ピボットテーブルのフィルタリングフィールドは「カテゴリー".
4)参照されるセルはH6です。 これらの変数値は、必要に応じて変更できます。

4。 プレス 他の + Q を閉じるためのキー アプリケーション向け Microsoft Visual Basic 窓。

これで、ピボットテーブルのフィルター機能がセルH6にリンクされました。

セルH6を更新すると、ピボットテーブルの対応するデータが既存の値に基づいて除外されます。 スクリーンショットを参照してください:

セルの値を変更すると、ピボットテーブルでフィルタリングされたデータが自動的に変更されます。 スクリーンショットを参照してください:


certian列のセル値に基づいて行全体を簡単に選択します。

世界 特定のセルを選択 の有用性 Kutools for Excel 以下のスクリーンショットに示すように、Excelのcertian列のセル値に基づいて行全体をすばやく選択するのに役立ちます。 セルの値に基づいてすべての行を選択した後、Excelで必要に応じて、それらを手動で新しい場所に移動またはコピーできます。
ダウンロードして今すぐ試してみてください! (30-日フリートレイル)


関連記事:


最高のオフィス生産性ツール

Kutools for Excelはほとんどの問題を解決し、生産性を80%向上させます

  • 再利用: すばやく挿入 複雑な数式、チャート および以前に使用したものすべて。 セルを暗号化する パスワード付き。 メーリングリストを作成する そしてメールを送る...
  • スーパーフォーミュラバー (複数行のテキストと数式を簡単に編集できます); 読書レイアウト (多数のセルを簡単に読み取って編集する); フィルター範囲に貼り付け...
  • セル/行/列をマージする データを失うことなく; 分割セルコンテンツ; 重複する行/列を組み合わせる...重複セルを防止します。 範囲を比較する...
  • [複製]または[一意]を選択します 行; 空白行を選択 (すべてのセルは空です); スーパーファインドとファジーファインド 多くのワークブックで; ランダム選択...
  • 正確なコピー 数式参照を変更せずに複数のセル。 参照の自動作成 複数のシートに; 箇条書きを挿入、チェックボックスなど...
  • テキストを抽出、テキストの追加、位置による削除、 スペースを削除する; ページング小計の作成と印刷。 セルの内容とコメントを変換する...
  • スーパーフィルター (フィルタースキームを保存して他のシートに適用します); 高度な並べ替え 月/週/日、頻度など。 特殊フィルター 太字、斜体...
  • ワークブックとワークシートを組み合わせる; キー列に基づいてテーブルをマージします。 データを複数のシートに分割; xls、xlsx、PDFをバッチ変換...
  • 300 以上の強力な機能. Office / Excel 2007-2021 および 365 をサポートします。すべての言語をサポートします。 企業や組織に簡単に導入できます。 フル機能の 30 日間無料トライアル。 60日間の返金保証。
kteタブ201905

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
officetab下部
コメントを並べ替える
コメント (36)
まだ評価はありません。 最初に評価してください!
このコメントは、サイトのモデレーターによって最小化されました
コードにはターゲットがXNUMXつしかないため、mul;tipleフィールドでそれを行う方法
このコメントは、サイトのモデレーターによって最小化されました
こんにちはフランク
ソリーはそれであなたを助けることができません。
このコメントは、サイトのモデレーターによって最小化されました
ピボットテーブル(この場合はH6)にリンクされているセルが別のワークシートにある場合はどうなりますか? コードをどのように変更しますか?
このコメントは、サイトのモデレーターによって最小化されました
複数のピボットテーブルがあり、1つのセルにリンクしている場合はどうなりますか。 コードをどのように修正しますか?
このコメントは、サイトのモデレーターによって最小化されました
こんにちはジェリ、
申し訳ありませんがそれであなたを助けることはできません。 私たちのフォーラムに質問を投稿することを歓迎します: 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
このコメントは、サイトのモデレーターによって最小化されました
ボアタルド...! Ótimapublicação、comofaçoparautilizar o filtro em duas ou maistabelasdinâmicas...? Agradeçodesdejá。

こんにちは...! すばらしい公開です。XNUMXつ以上のピボットテーブルでフィルターを使用するにはどうすればよいですか...? 前もって感謝します。
このコメントは、サイトのモデレーターによって最小化されました
こんにちはギルマーアルベス、
申し訳ありませんがそれであなたを助けることはできません。 私たちのフォーラムに質問を投稿することを歓迎します: https://www.extendoffice.com/forum.html Excelの専門家や他のExcelファンからより多くのExcelサポートを取得します。
このコメントは、サイトのモデレーターによって最小化されました
誰かが複数のピボットテーブルリンクの質問を理解しましたか?
このコメントは、サイトのモデレーターによって最小化されました
Array()、Worksheets()、Intersect()の値を変更する



**これらを見つけて変更してください**
シート名
E1
ピボットテーブル1
ピボットテーブル2
ピボットテーブル3




プライベートサブワークシート_Change(ByValターゲットを範囲として)
'更新者 Extendoffice 20180702
xPTableをピボットテーブルとして薄暗くする
xPFileをPivotFieldとして薄暗くする

ピボットテーブルとして薄暗い xPTabled
Dim xPFiled As PivotField

文字列としての薄暗いxStr



エラーで次の再開

'리스트만들기
Dim listArray()As Variant
listArray = Array( "PivotTable1"、 "PivotTable2"、 "PivotTable3")



Intersect(Target、Range( "E1"))が何もない場合は、Subを終了します
Application.ScreenUpdating = False

i = 0の場合UBound(listArray)へ

xPTable = Worksheets( "SheetName")。PivotTables(listArray(i))を設定します
xPFile = xPTable.PivotFields( "Company_ID")を設定します

xStr = ターゲット.テキスト
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



次へ

Application.ScreenUpdating = True



End Subの
このコメントは、サイトのモデレーターによって最小化されました
Ciao、sto provando a fare lo stesso esempio per far in modo che il filtro dellaivot si setti sul valore della cella、
非riescoafarlafunzionare。

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

これを列フィルターで機能させようとしましたが、機能していないようです。 そのために他のコードが必要ですか?

感謝
このコメントは、サイトのモデレーターによって最小化されました
こんにちはジャスティン、
エラープロンプトが表示されましたか? 私はあなたの問題についてもっと具体的に知る必要があります。
コードを適用する前に、「シートの名前""ピボットテーブルの名前""ピボットテーブルのフィルターの名前" そしてその セル に基づいてピボットテーブルをフィルタリングします(sceenshotを参照)。
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
このコメントは、サイトのモデレーターによって最小化されました
こんにちはクリスタル、

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

ピボット名: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または添付のワークブックを参照してください。
新しいワークブックを作成して、コードを再試行してもよろしいですか?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.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
このコメントは、サイトのモデレーターによって最小化されました
通常のエクセルに使用しましたが、動作しましたが、OLAPワークシートには使用できませんでした。 多分私はそれを少し変更する必要がありますか?
このコメントは、サイトのモデレーターによって最小化されました
こんにちはmaziaritib4TIB、
この方法は、MicrosoftExcelでのみ使用できます。 ご不便おかけしてすみません。
このコメントは、サイトのモデレーターによって最小化されました
こんにちはジャスティン、

これは完全に機能しましたが、このルールを同じシート内の複数のピボットテーブルに適用できるかどうか疑問に思っています。

おかげで、
James
このコメントは、サイトのモデレーターによって最小化されました
こんにちはジェームズ、

はい、これは可能です。これに使用したコードは(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の
このコメントは、サイトのモデレーターによって最小化されました
Array()、Worksheets()、Intersect()の値を変更する



**これらを見つけて変更してください**
シート名
E1
ピボットテーブル1
ピボットテーブル2
ピボットテーブル3




プライベートサブワークシート_Change(ByValターゲットを範囲として)
'更新者 Extendoffice 20180702
xPTableをピボットテーブルとして薄暗くする
xPFileをPivotFieldとして薄暗くする

ピボットテーブルとして薄暗い xPTabled
Dim xPFiled As PivotField

文字列としての薄暗いxStr



エラーで次の再開

'리스트만들기
Dim listArray()As Variant
listArray = Array( "PivotTable1"、 "PivotTable2"、 "PivotTable3")



Intersect(Target、Range( "E1"))が何もない場合は、Subを終了します
Application.ScreenUpdating = False

i = 0の場合UBound(listArray)へ

xPTable = Worksheets( "SheetName")。PivotTables(listArray(i))を設定します
xPFile = xPTable.PivotFields( "Company_ID")を設定します

xStr = ターゲット.テキスト
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



次へ

Application.ScreenUpdating = True



End Subの
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、

コードは私にとっては問題なく動作します。 ただし、ピボットテーブルを取得してフィルターターゲットを自動的に更新することができません。 私の場合のターゲットは式[DATE(D18、S14、C18)]です。 このコードは、ターゲットセルをダブルクリックしてEnterキーを押した場合にのみ機能します。

ありがとうございました
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、

このコードは完全に機能します。 ただし、ピボットテーブルを自動的に更新するコードを取得できません。 私の目標値は、D18で何を選択するかによって変わる式(= DATE(D18、..、..))です。 ピボットテーブルを更新するには、ターゲットセルをダブルクリックしてEnterキーを押す必要があります。 それを回避する方法はありますか?

ありがとうございました
このコメントは、サイトのモデレーターによって最小化されました
こんにちは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
このコメントは、サイトのモデレーターによって最小化されました
こんにちはクリサル、

コードに次の行を追加しました:Dim xRg As Range

コードは、ターゲットが変更されたときに日付を自動的にリセットしません。 私は自分がやろうとしていることを複製したExcelファイルを持っていますが、このWebサイトに添付ファイルを追加することはできません。 D3(target = DATE(A15、B15、C15))には、A15、B15、およびC15にリンクされた方程式があります。 A15、B15、およびC15のいずれかの値が変更されると、ピボットテーブルはフィルターなしにリセットされます。 これについて私を助けてくれませんか?
このコメントは、サイトのモデレーターによって最小化されました
こんにちはST、
私はあなたが何を意味するのかよくわかりません。 あなたの場合、ターゲットセルD3の値は、ピボットテーブルをフィルタリングするために使用されます。 ターゲットセルD3の数式は、セルA15、B15、およびC15の値を参照します。これらの値は、参照セルの値に応じて変化します。 A15、B15、およびC15のいずれかの値が変更された場合、ターゲットセルの値がピボットテーブルのフィルター条件を満たしていれば、ピボットテーブルは自動的にフィルター処理されます。 ターゲットセルの値がピボットテーブルのフィルタリング基準を満たさない場合、ピボットテーブルは自動的にフィルタリングなしにリセットされます。
このコメントは、サイトのモデレーターによって最小化されました
Excel ファイルを共有する方法があるかどうかわかりません。 日付である私の目標値が、他のセルの変化に応じて変化する場合。 ピボット テーブルを更新するには、ターゲット セルをダブルクリックして Enter キーを押す必要があります (セルに数式を入力した後と同じように)。
このコメントは、サイトのモデレーターによって最小化されました
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
このコメントは、サイトのモデレーターによって最小化されました
これらを見つけて、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
このコメントは、サイトのモデレーターによって最小化されました
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек? 1 枚の写真はありますか?
このコメントは、サイトのモデレーターによって最小化されました
こんにちは。

このコメントの VBA コードかどうかを確認してください #38754 助けることができる。
このコメントは、サイトのモデレーターによって最小化されました
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе? あなたは何をしていますか? подскажите пожалуйста.
このコメントは、サイトのモデレーターによって最小化されました
こんにちは。

コードを変更する必要はありません。参照するセルのワークシートに VBA コードを追加するだけです。
たとえば、「ピボットテーブル1"で Sheet2 セルの値に基づく H6 in Sheet3、右クリックしてください Sheet3 ワークシート タブで、 コードを表示 右クリック メニューから、コードを Sheet3 (コード) 窓。
ここにはまだコメントが投稿されていません
あなたのコメントを残す
ゲストとして投稿
×
この投稿を評価:
0   文字
推奨される場所

フォローする

著作権©の2009 - WWW。extendoffice.com。 | | 全著作権所有。 搭載 ExtendOffice。 | サイトマップ
MicrosoftおよびOfficeのロゴは、米国MicrosoftCorporationの米国およびその他の国における商標または登録商標です。
SectigoSSLで保護