Note: The other languages of the website are Google-translated. Back to English
登入 立即註冊

如何將數據透視表過濾器鏈接到Excel中的某個單元格？

如果要將數據透視表篩選器鏈接到某個單元格，並根據該單元格值對數據透視表進行篩選，則本文中的方法可以為您提供幫助。

使用VBA代碼將數據透視表過濾器鏈接到特定單元格

使用VBA代碼將數據透視表過濾器鏈接到特定單元格

您要將其篩選器功能鏈接到單元格值的數據透視表應包含一個篩選器字段（篩選器字段的名稱在以下VBA代碼中起著重要作用）。

以下面的數據透視表為例，數據透視表中的過濾器字段稱為 類別，其中包括兩個值“支出“和”銷售”。 將數據透視表篩選器鏈接到一個單元格後，將應用於篩選數據透視表的單元格值應為“費用”和“銷售”。

1.請選擇一個單元格（在這裡我選擇單元格H6），您將鏈接到數據透視表的過濾器功能，並提前在該單元格中輸入一個過濾器值。

2.打開包含要鏈接到單元格的數據透視表的工作表。 右鍵單擊工作表標籤，然後選擇 查看代碼 從上下文菜單中。 看截圖：

3。 在裡面 Microsoft Visual Basic for Applications 窗口，將下面的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 for Applications 窗口。

現在，數據透視表的篩選功能已鏈接到單元格H6。

刷新單元格H6，然後根據現有值過濾出數據透視表中的相應數據。 看截圖：

更改單元格值時，數據透視表中的篩選數據將自動更改。 看截圖：

根據certian列中的單元格值輕鬆選擇整個行：

選擇特定的單元格 的效用 Excel的Kutools 可以幫助您基於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中啟用選項卡式編輯和閱讀，發布者，Access，Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%，每天為您減少數百次鼠標點擊！
officetab底部
按評論排序
最舊的
最新的
留言 (36)
還沒有評分。 成為第一位評論！
坦率
坦率
網站主持人對此評論進行了最小化
如何在多個字段上執行此操作，因為在代碼中只有一個目標
回复
0
0
水晶
水晶     坦率
網站主持人對此評論進行了最小化
嗨弗蘭克
Sory 幫不了你。
回复
即時報告
0
0
薩拉
薩拉
網站主持人對此評論進行了最小化
如果鏈接到數據透視表的單元格（在本例中為 H6）位於另一個工作表上怎麼辦？ 它如何更改代碼？
回复
0
0
傑里
傑里
網站主持人對此評論進行了最小化
如果我有超過 1 個數據透視表並鏈接到 1 個單元格怎麼辦。 我該如何修改代碼？
回复
0
0
水晶
水晶     傑里
網站主持人對此評論進行了最小化
嗨，傑里，
抱歉不能幫你。 歡迎在我們的論壇發表任何問題： https://www.extendoffice.com/forum.html 從 Excel 專業人士或其他 Excel 粉絲那裡獲得更多 Excel 支持。
回复
即時報告
0
0
iamjuneyong2 정
iamjuneyong2 정     傑里
網站主持人對此評論進行了最小化
找到這些並在 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
回复
即時報告
0
0
吉爾瑪·阿爾維斯
吉爾瑪·阿爾維斯
網站主持人對此評論進行了最小化
遲到的蟒蛇……！ Ótima publicação, como faço para utilizar o filtro em duas ou mais tabelas dinâmicas...？ Agradeço desde já.

下午好...！ 偉大的出版，我如何在兩個或更多數據透視表中使用過濾器......？ 提前致謝。
回复
0
0
水晶
水晶     吉爾瑪·阿爾維斯
網站主持人對此評論進行了最小化
嗨吉爾瑪阿爾維斯，
抱歉不能幫你。 歡迎在我們的論壇發表任何問題： https://www.extendoffice.com/forum.html 從 Excel 專業人士或其他 Excel 粉絲那裡獲得更多 Excel 支持。
回复
即時報告
0
0
邁克爾·
邁克爾·     水晶
網站主持人對此評論進行了最小化
有沒有人想出多個數據透視錶鍊接問題？
回复
0
0
均勇
均勇     吉爾瑪·阿爾維斯
網站主持人對此評論進行了最小化
更改 Array()、Worksheets() 和 Intersect() 中的值



**找到這些並更改它**
工作表名稱
E1
數據透視表1
數據透視表2
數據透視表3




Private Sub Worksheet_Change（ByVal Target As Range）
'更新 Extendoffice 20180702
將 xPTable 調暗為數據透視表
將 xPFile 調暗為 PivotField

將 xPTabled 調暗為數據透視表
將 xP 歸檔為 PivotField

將 xStr 調暗為字符串



在錯誤恢復下一頁

'리스트 만들기
暗淡 listArray() 作為變體
listArray = Array("數據透視表1", "數據透視表2", "數據透視表3")



如果 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
回复
0
0
伊利莎
伊利莎
網站主持人對此評論進行了最小化
再見，sto provando a fare lo stesso esempio per far in modo che il filtro della pivot si setti sul valore della cella，
non riesco a farla funzionare。

Quale passaggio manca nella descrizione sopra？
回复
0
0
水晶
水晶     伊利莎
網站主持人對此評論進行了最小化
嗨，
你有沒有得到任何錯誤提示？ 我需要更具體地了解您的問題，例如您的 Excel 版本。 如果您不介意，請嘗試在新工作簿中創建數據並再次嘗試，或者截取數據並在此處上傳。
回复
即時報告
0
0
賈斯汀
賈斯汀
網站主持人對此評論進行了最小化
嗨，

試圖讓它適用於列過濾器，但似乎不起作用。 我需要其他代碼嗎？

謝謝
回复
0
0
水晶
水晶     賈斯汀
網站主持人對此評論進行了最小化
嗨賈斯汀，
你有沒有得到任何錯誤提示？ 我需要更具體地了解您的問題。
在應用代碼之前，不要忘記修改“工作表名稱“”數據透視表的名稱“”數據透視表的過濾器名稱“和 細胞 您想根據（見截圖）過濾數據透視表。
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
回复
即時報告
0
0
賈斯汀·蒂烏
賈斯汀·蒂烏     水晶
網站主持人對此評論進行了最小化
嗨水晶，

謝謝你的幫助。 問題是該功能由於某種原因沒有做任何事情。 一些澄清：

數據透視名稱：Order_Comp_B2C
表名稱：計算表
過濾器名稱：Week Number（我將這個名稱從數據文件中的“Dispatch Week No”更改為）
要更改的單元格：O26 和 O27（這應該在範圍內）

在這個數據透視中，我試圖更改列的過濾器，我在數據透視表字段菜單的過濾器區域中沒有任何內容。

我的代碼是：

Private Sub Worksheet_Change（ByVal Target As Range）
'更新 Extendoffice 20180702
將 xPTable 調暗為數據透視表
將 xPFile 調暗為 PivotField
將 xStr 調暗為字符串
在錯誤恢復下一頁
如果 Intersect(Target, Range("O26")) 什麼都不是，則退出 Sub
Application.ScreenUpdating = False
設置 xPTable = Worksheets("計算表").PivotTables("Order_Comp_B2C")
設置 xPFile = xPTable.PivotFields("週數")
xStr = 目標文本
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
END SUB

謝謝，

賈斯汀
回复
即時報告
0
0
水晶
水晶     賈斯汀·蒂烏
網站主持人對此評論進行了最小化
嗨賈斯汀·蒂烏，
我改變了 樞軸名稱, 工作表名稱, 過濾器名稱 及 要改變的單元格 根據您上面提到的條件，並嘗試了您提供的 VBA 代碼，它在我的情況下運行良好。 請參閱以下 GIF 或隨附的工作簿。
您介意創建一個新工作簿並再次嘗試該代碼嗎？
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
查看附件 (1 / 5）
回复
即時報告
0
0
賈斯汀·蒂烏
賈斯汀·蒂烏     水晶
網站主持人對此評論進行了最小化
嗨水晶，

附上pivot的截圖，紅框是我想根據單元格值改變的過濾器。

最好我想使用一系列表示多個週數的單元格。

謝謝，

賈斯汀
回复
即時報告
0
0
水晶
水晶     賈斯汀·蒂烏
網站主持人對此評論進行了最小化
嗨賈斯汀，
抱歉，我沒有看到您在頁面上附加的屏幕截圖。 也許頁面上有一些錯誤。
如果您仍然需要解決問題，請通過 zxm@addin99.com 給我發送電子郵件。 帶來不便敬請諒解。
即時報告
0
0
水晶
水晶     賈斯汀·蒂烏
網站主持人對此評論進行了最小化
嗨賈斯汀·蒂烏，
請嘗試以下 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
即時報告
0
0
maziartib4 TIB
maziartib4 TIB
網站主持人對此評論進行了最小化
我將它用於普通的 Excel 並且它有效。但我不能將它用於 olap 工作表。 也許我需要稍微改變一下？
回复
即時報告
0
0
水晶
水晶     maziartib4 TIB
網站主持人對此評論進行了最小化
嗨 maziaritib4 TIB，
該方法僅適用於 Microsoft Excel。 帶來不便敬請諒解。
回复
即時報告
0
0
雅各書
雅各書
網站主持人對此評論進行了最小化
嗨賈斯汀，

這工作得很好，但是，我想知道這個規則是否可以應用於同一張表中的多個數據透視表？

謝謝，
雅各書
回复
0
0
賈斯汀·蒂烏
賈斯汀·蒂烏     雅各書
網站主持人對此評論進行了最小化
嗨詹姆斯，

是的，這是可能的，我用於此的代碼是（4 個樞軸和 2 個單元格引用）：

Private Sub Worksheet_Change（ByVal Target As Range）
將 I 調暗為整數
將 xFilterStr1、xFilterStr2、yFilterstr1、yfilterstr2 調暗為字符串
在錯誤恢復下一頁
如果 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("週數")。 _
清除所有過濾器

如果 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("週數").PivotItems.Count
xCount = ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("週數").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("週數").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("週數").PivotItems.Count

對於 I = 1 到 xCount
如果我 <> xFilterStr1 並且我 <> xFilterStr2 那麼
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("週數").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("週數").PivotItems(I).Visible = False
其他
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("週數").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("週數").PivotItems(I).Visible = True
如果結束
下一頁

對於 I = 1 到 yCount
如果我 <> yFilterstr1 並且我 <> yfilterstr2 那麼
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("週數").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("週數").PivotItems(I).Visible = False
其他
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("週數").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("週數").PivotItems(I).Visible = True
如果結束
下一頁

END SUB
回复
即時報告
0
0
均勇
均勇     雅各書
網站主持人對此評論進行了最小化
更改 Array()、Worksheets() 和 Intersect() 中的值



**找到這些並更改它**
工作表名稱
E1
數據透視表1
數據透視表2
數據透視表3




Private Sub Worksheet_Change（ByVal Target As Range）
'更新 Extendoffice 20180702
將 xPTable 調暗為數據透視表
將 xPFile 調暗為 PivotField

將 xPTabled 調暗為數據透視表
將 xP 歸檔為 PivotField

將 xStr 調暗為字符串



在錯誤恢復下一頁

'리스트 만들기
暗淡 listArray() 作為變體
listArray = Array("數據透視表1", "數據透視表2", "數據透視表3")



如果 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
回复
0
0
ST
ST
網站主持人對此評論進行了最小化
你好，

該代碼對我來說很好。 但是我無法讓數據透視表自動更新過濾器目標。 在我的例子中，目標是一個公式 [DATE(D18,S14,C18)]。 該代碼僅在我雙擊目標單元格並按 Enter 時才有效。

謝謝
回复
0
0
ST
ST
網站主持人對此評論進行了最小化
你好，

此代碼完美運行。 但是我無法獲取自動更新數據透視表的代碼。 我的目標值是一個公式 (=DATE(D18,..,..))，它會根據在 D18 中選擇的內容而變化。 為了更新數據透視表，我必須雙擊目標單元格並按 Enter。 有辦法解決嗎？

謝謝
回复
0
0
水晶
水晶     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
回复
即時報告
0
0
ST
ST     水晶
網站主持人對此評論進行了最小化
你好水晶，

我在代碼上添加了一行：Dim xRg As Range

更改目標時，代碼不會自動重置日期。 我有一個複制我想要做的事情的 excel 文件，但我無法在這個網站上添加附件。 D3 (target = DATE(A15,B15,C15)) 有一個與 A15、B15 和 C15 相關聯的方程式。 當 A15、B15 和 C15 上的任何值更改時，數據透視表將重置為無過濾器。 你能幫我解決這個問題嗎？
回复
0
0
水晶
水晶     ST
網站主持人對此評論進行了最小化
嗨，ST，
我不太明白你的意思。 在您的情況下，目標單元格 D3 的值用於過濾數據透視表。 目標單元格 D3 中的公式引用了單元格 A15、B15 和 C15 的值，這些值將根據參考單元格中的值而變化。 當A15、B15、C15上的任意值發生變化時，如果目標單元格中的值滿足數據透視表的過濾條件，數據透視表將被自動過濾。 如果目標單元格中的值不符合數據透視表的過濾條件，數據透視表將自動重置為不過濾。
回复
即時報告
0
0
薩加爾 T
薩加爾 T     水晶
網站主持人對此評論進行了最小化
我不確定是否有辦法與您共享 excel 文件。 如果我的目標值（即日期）根據其他單元格的變化而變化。 我必須雙擊目標單元格並按 Enter 鍵（就像在單元格中輸入公式後一樣）以更新數據透視表
回复
0
0
水晶
水晶     薩加爾 T
網站主持人對此評論進行了最小化
嗨，薩加爾 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
查看附件 (1 / 5）
即時報告
0
0
iamjuneyong2 정
iamjuneyong2 정
網站主持人對此評論進行了最小化
找到這些並在 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
回复
即時報告
0
0
阿列克謝
阿列克謝
網站主持人對此評論進行了最小化
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек？ а не 1 как в примере？
回复
0
0
水晶
水晶     阿列克謝
網站主持人對此評論進行了最小化
嗨 Алексей,

請檢查此評論中是否包含 VBA 代碼 #38754 可以提供幫助。
回复
即時報告
0
0
阿列克謝
阿列克謝
網站主持人對此評論進行了最小化
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе？ как это сделать? подскажите пожалуйста。
回复
0
0
水晶
水晶     阿列克謝
網站主持人對此評論進行了最小化
嗨 Алексей,

您無需修改代碼，只需將 VBA 代碼添加到您要引用的單元格的工作表中即可。
例如，如果你想過濾一個名為“數據透視表1“中 Sheet2 基於單元格的值 H6 in Sheet3, 請右擊 Sheet3 工作表選項卡，單擊 查看代碼 從右鍵單擊菜單，然後將代碼添加到 Sheet3（代碼） 窗口。
回复
即時報告
0
0
這裡還沒有評論
留下你的意見
客人
以訪客身份發帖
登入
×
評價此帖子：
重設
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護