メインコンテンツへスキップ

ピボットテーブルフィルターを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 AI アシスタント: 以下に基づいてデータ分析に革命をもたらします。 インテリジェントな実行   |  コードを生成  |  カスタム数式の作成  |  データを分析してグラフを生成する  |  Kutools関数を呼び出す...
人気の機能: 重複を検索、強調表示、または識別する   |  空白行を削除する   |  データを失わずに列またはセルを結合する   |   数式なしのラウンド ...
スーパールックアップ: 複数の基準の VLookup  |   複数の値の VLookup  |   複数のシートにわたる VLookup   |   ファジールックアップ ....
詳細ドロップダウン リスト: ドロップダウンリストを素早く作成する   |  依存関係のドロップダウン リスト   |  複数選択のドロップダウンリスト ....
列マネージャー: 特定の数の列を追加する  |  列の移動  |  Toggle 非表示列の表示ステータス  |  範囲と列の比較 ...
注目の機能: グリッドフォーカス   |  デザインビュー   |   ビッグフォーミュラバー   |  ワークブックとシートマネージャー   |  リソースライブラリ (自動テキスト)   |  日付ピッカー   |  ワークシートを組み合わせる   |  セルの暗号化/復号化   |  リストごとにメールを送信する   |  スーパーフィルター   |   特殊フィルター (太字/斜体/取り消し線をフィルター...) ...
上位 15 のツールセット:  12 テキスト ツール (テキストを追加, 文字を削除する、...）   |   50+ チャート 種類 (ガントチャート、...）   |   40+ 実用的 式 (誕生日に基づいて年齢を計算する、...）   |   19 挿入 ツール (QRコードを挿入, パスから画像を挿入、...）   |   12 変換 ツール (数字から言葉へ, 通貨の換算、...）   |   7 マージ＆スプリット ツール (高度な結合行, 分割セル、...）   |   ... もっと

Kutools for Excel で Excel スキルを強化し、これまでにない効率を体験してください。 Kutools for Excelは、生産性を向上させ、時間を節約するための300以上の高度な機能を提供します。  最も必要な機能を入手するにはここをクリックしてください...

説明

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

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
Comments (38)
No ratings yet. Be the first to rate!
Cass
Cass
This comment was minimized by the moderator on the site
Hi,
This code worked perfectly on the pivot table, but I also want to link a filter to a cell value on a Table. Is there code for this? Please help :)
Reply
0
0
Oleksandr
Oleksandr
This comment was minimized by the moderator on the site
if my column in pivot table is date this code not working, can some one help me please
Reply
0
0
Алексей
Алексей
This comment was minimized by the moderator on the site
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе? как это сделать? подскажите пожалуйста.
Reply
0
0
crystal
crystal     Алексей
This comment was minimized by the moderator on the site
Hi Алексей,

You don't need to modify the code, just add the VBA code to the worksheet of the cell you want to reference.
For example, if you want to filter a pivot table named "PivotTable1" in Sheet2 based on the value of cell H6 in Sheet3, please right click the Sheet3 worksheet tab, click View Code from the right-clicking menu, and then add the code to the Sheet3 (Code) window.
Reply
Report
0
0
Алексей
Алексей
This comment was minimized by the moderator on the site
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек? а не 1 как в примере?
Reply
0
0
crystal
crystal     Алексей
This comment was minimized by the moderator on the site
Hi Алексей,

Please check if the VBA code in this comment #38754 can help.
Reply
Report
0
0
Juneyong
Juneyong
This comment was minimized by the moderator on the site
find these and change it in Array(),Intersect(), Worksheets(), PivotFields()

PivotTable1
PivotTable2
PivotTable3
PivotTable4
H1
SheetName
FieldName




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
Reply
Report
0
0
ST
ST
This comment was minimized by the moderator on the site
Hello,

This code works perfectly. However I am not able to get the code to update the pivot table automatically. The target value for me is a formula (=DATE(D18,..,..)) which changes depending on what is selected at D18. For it to update the pivot table i have to double click the target cell and hit enter. Is there a way around it?

Thank you
Reply
0
0
crystal
crystal     ST
This comment was minimized by the moderator on the site
Hello ST,
Suppose your target value is in H6 and it changes depending on the value in D18. To filter a pivot table based on this target value. The following VBA code can help. Please give it a try.
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
Reply
Report
0
0
ST
ST     crystal
This comment was minimized by the moderator on the site
Hello Crysal,

I added a line on the code : Dim xRg As Range

The code doesn't automatically reset the dates when the target is changed. I have an excel file replicating what I am trying to do, I a not able to add attachments on this website though. D3 (target = DATE(A15,B15,C15)) has an equation linked to A15, B15 and C15. When any value on A15, B15 and C15 is changed the pivot table resets to no filter. Could you help me out on this?
Reply
0
0
crystal
crystal     ST
This comment was minimized by the moderator on the site
Hi ST,
I don't quite understand what you mean. In your case, the value of target cell D3 is used to filter the pivot table. The formula in the target cell D3 references the values of cells A15, B15 and C15, which will change according to the values in the reference cells. When any value on A15, B15 and C15 is changed, the pivot table will be automatically filtered if the value in the target cell meets the filter conditions of the pivot table. If the value in the target cell does not meet the pivot table's filtering criteria, the pivot table will be automatically reset to no filtering.
Reply
Report
0
0
Sagar T
Sagar T     crystal
This comment was minimized by the moderator on the site
I’m not sure if there is a way to share an excel file with you. If my target value, which is a date, changes according to changes in other cells. I have to double click on the target cell and hit enter (like you would after entering a formula in a cell) to update the pivot table
Reply
0
0
crystal
crystal     Sagar T
This comment was minimized by the moderator on the site
Hi Sagar T,
The code has been updated. Please give it a try. Thanks for your feedback.
Don't forget to change the names of the worksheet, pivot table and the filter in the code. Or you can download the following uploaded workbook for testing.

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
View Attachments (1 / 5)
Report
0
0
ST
ST
This comment was minimized by the moderator on the site
Hello,

The code works fine for me. However I am not able to get the pivot table to update the filter target automatically. The target in my case is a formula [DATE(D18,S14,C18)]. The code only works when I double click the target cell and hit enter.

Thank you
Reply
0
0
James
James
This comment was minimized by the moderator on the site
Hi Justin,

This has worked perfectly, however, I am wondering if this rule can be applied to multiple PivotTables within the same sheet?

Thanks,
James
Reply
0
0
Juneyong
Juneyong     James
This comment was minimized by the moderator on the site
Change Values in Array(), Worksheets() and Intersect()



**Find these and change it**
SheetName
E1
PivotTable1
PivotTable2
PivotTable3




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")



If Intersect(Target, Range("E1")) 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("Company_ID")

xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Next

Application.ScreenUpdating = True



End Sub
Reply
0
0
JustinT
JustinT     James
This comment was minimized by the moderator on the site
Hi James,

Yes this is possible, code I used for this is (4 pivots and 2 cell references):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Integer
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 As String
On Error Resume Next
If Intersect(Target, Range("O26:P27")) Is Nothing Then Exit Sub

xFilterStr1 = Range("O26").Value
xFilterStr2 = Range("O27").Value
yFilterstr1 = Range("p26").Value
yfilterstr2 = Range("p27").Value
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Week Number"). _
ClearAllFilters

If xFilterStr1 = "" And xFilterStr2 = "" And yFilterstr1 = "" And yfilterstr2 = "" Then Exit Sub
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Week Number"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Week Number"). _
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

For I = 1 To xCount
If I <> xFilterStr1 And I <> xFilterStr2 Then
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
Else
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
End If
Next

For I = 1 To yCount
If I <> yFilterstr1 And I <> yfilterstr2 Then
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
Else
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 If
Next

End Sub
Reply
Report
0
0
maztib
maztib
This comment was minimized by the moderator on the site
I used it for a normal excell and it worked.But I could not use it for an olap worksheets. maybe I need to change it a little?
Reply
Report
0
0
crystal
crystal     maztib
This comment was minimized by the moderator on the site
Hi maziaritib4 TIB,
The method is only avaliable for Microsoft Excel. Sorry for the inconvenience.
Reply
Report
0
0
Justin
Justin
This comment was minimized by the moderator on the site
Hi,

Tried to get this working for the column filter but does not seem to work. Do I need an other code for that?

Thanks
Reply
0
0
crystal
crystal     Justin
This comment was minimized by the moderator on the site
Hi Justin,
Did you get any error prompt? I need to know more specific about your issue.
Before applying the code, don't forget to modify the "name of the sheet", "name of the pivot table", "name of the filter of pivot table" and the cell you want to filter the pivot table based on (see sceenshot).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Reply
Report
0
0
JustinT
JustinT     crystal
This comment was minimized by the moderator on the site
Hi Crystal,

Thanks for your help. Issue is the function is not doing anything for some reason. Some clarification:

Pivot name: Order_Comp_B2C
Sheet Name: Calculation Sheet
Filter name: Week Number (I changed this name from what was "Dispatch Week No" in the data file)
Cell to change: O26 and O27 (this should go in range)

In this pivot, I am trying to get the filter changed for the columns, I have nothing in the filter area in the PivotTable Fields menu.

my code is:

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("O26")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Calculation Sheet").PivotTables("Order_Comp_B2C")
Set xPFile = xPTable.PivotFields("Week Number")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Thanks,

Justin
Reply
Report
0
0
crystal
crystal     JustinT
This comment was minimized by the moderator on the site
Hi Justin Teeuw,
I have changed the Pivot name, sheet name, filter name and cell to change to the conditions you mentioned above, and tried the VBA code you provided, it works well in my case. See the following GIF or the attached workbook.
Do you mind creating a new workbook and try the code again?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
View Attachments (1 / 5)
Reply
Report
0
0
JustinT
JustinT     crystal
This comment was minimized by the moderator on the site
Hi Crystal,

Attached a screenshot of the pivot, the red box is the filter I would like to change based on the cell value.

Preferably I would like to use a range of cells indicating multiple week numbers.

Thanks,

Justin
Reply
Report
0
0
crystal
crystal     JustinT
This comment was minimized by the moderator on the site
Hi Justin Teeuw，
Please try the following VBA code. Hope I can help.

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
Report
0
0
crystal
crystal     JustinT
This comment was minimized by the moderator on the site
Hi Justin,
Sorry I didn't see the screenshot you attached on the page. Maybe there is some error on the page.
If you still need to solve the problem, email me via . Sorry for the inconvenience.
Report
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations