Բարև Ֆրենկ
Սորին չի կարող ձեզ օգնել այդ հարցում:

Բարև Ջերի,
Կներեք, չեմ կարող օգնել ձեզ այդ հարցում: Բարի գալուստ ցանկացած հարց տեղադրել մեր ֆորումում. https://www.extendoffice.com/forum.html Excel-ի մասնագետներից կամ Excel-ի այլ երկրպագուներից ավելի շատ Excel աջակցություն ստանալու համար:

գտեք դրանք և փոխեք այն Array(), Intersect(), Worksheets(), PivotFields() մեջ:

Առանցքային աղյուսակ 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 տարբերակը: Եվ եթե դեմ չեք, փորձեք ստեղծել ձեր տվյալները նոր աշխատանքային գրքում և նորից փորձեք, կամ վերցրեք ձեր տվյալների սքրինշոթը և վերբեռնեք այստեղ:

Բարև Ջասթին,
Ստացե՞լ եք որևէ սխալի հուշում: Ես պետք է ավելի կոնկրետ իմանամ ձեր խնդրի մասին:
Նախքան կոդը կիրառելը, մի մոռացեք փոփոխել «թերթիկի անվանումը""առանցքային աղյուսակի անվանումը""առանցքային աղյուսակի ֆիլտրի անվանումը" եւ բջիջ դուք ցանկանում եք զտել առանցքային աղյուսակը հիմնվելով (տե՛ս նկարը):

Բարև Կրիստալ,

Շնորհակալություն ձեր օգնության համար: Խնդիրն այն է, որ ֆունկցիան ինչ-ինչ պատճառներով ոչինչ չի անում: Որոշ պարզաբանումներ.

Առանցքային անվանումը՝ Order_Comp_B2C
Թերթի անվանումը՝ Հաշվարկային թերթիկ
Զտիչի անունը. Շաբաթվա համարը (ես փոխել եմ այս անունը տվյալների ֆայլում «Dispatch Week No»-ից)
Փոխելու բջիջ՝ O26 և O27 (սա պետք է լինի միջակայքում)

Այս առանցքում, ես փորձում եմ փոխել ֆիլտրը սյունակների համար, ես ոչինչ չունեմ ֆիլտրի տարածքում PivotTable Fields ցանկում:

իմ կոդը հետևյալն է.

Private Sub Worksheet_Change (ByVal Target as Range)
«Թարմացվել է Extendoffice 20180702
Dim xPTable Որպես PivotTable
Խոնավեցրեք xPFile-ը որպես առանցքային դաշտ
Dim xStr Որպես տող
Ս.թ. սխալի Ռեզյումե Next
Եթե ​​խաչմերուկը (Target, Range ("O26")) ոչինչ է, ապա դուրս եկեք Sub
Դիմում. ScreenUpdating = Սուտ է
Սահմանել xPTable = Worksheets («Հաշվարկային թերթ»). PivotTables («Order_Comp_B2C»)
Սահմանել xPFile = xPTable.PivotFields («Շաբաթվա համար»)
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Դիմում. ScreenUpdating = ueիշտ է
Վերջ Sub

Thanks,

Justin

Բարև Ջասթին Թիու,
Ես փոխել եմ Առանցքային անունը, թերթի անունը, ֆիլտրի անունը և բջիջը փոխելու համար Ձեր նշած պայմաններով և փորձեցի ձեր տրամադրած VBA կոդը, այն լավ է աշխատում իմ դեպքում: Տես հետևյալ GIF-ը կամ կից աշխատանքային գրքույկը։
Դեմ ե՞ք ստեղծել նոր աշխատանքային գրքույկ և նորից փորձել կոդը:

Բարև Կրիստալ,

Կցված է առանցքի սքրինշոթը, կարմիր տուփը այն զտիչն է, որը ես կցանկանայի փոխել՝ ելնելով բջջի արժեքից:

Ցանկալի է, որ ես կցանկանայի օգտագործել մի շարք բջիջներ, որոնք ցույց են տալիս շաբաթվա մի քանի թվեր:

Thanks,

Justin

Բարև Ջասթին,
Կներեք, որ չտեսա ձեր կցված սքրինշոթը էջում: Գուցե էջի վրա ինչ-որ սխալ կա:
Եթե ​​դուք դեռ պետք է լուծեք խնդիրը, գրեք ինձ zxm@addin99.com հասցեով: Ներողություն անհանգստության համար.

Բարև Ջասթին Թիու,
Խնդրում ենք փորձել հետևյալ 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

Ողջույն maziaritib4 TIB,
Մեթոդը հասանելի է միայն Microsoft Excel-ի համար: Ներողություն անհանգստության համար.

Hi James,

Այո, դա հնարավոր է, կոդն է, որը ես օգտագործել եմ դրա համար (4 առանցք և 2 բջջային հղում).

Private Sub Worksheet_Change (ByVal Target as Range)
Dim I Որպես ամբողջ թիվ
Դեմ xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 որպես տող
Ս.թ. սխալի Ռեզյումե Next
Եթե ​​հատվում է (Target, Range("O26:P27")) ոչինչ է, ապա դուրս եկեք ենթակետից

xFilterStr1 = Շրջանակ («O26»): Արժեք
xFilterStr2 = Շրջանակ («O27»): Արժեք
yFilterstr1 = Շրջանակ («p26»): Արժեք
yfilterstr2 = Շրջանակ ("p27"): Արժեք
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 = "" Եվ xFilterStr2 = "" Եվ yFilterstr1 = "" Եվ yfilterstr2 = "" Ապա Դուրս եկեք ենթակետից
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 = Ճշմարիտ

xCount = ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Sheet Number").PivotItems.Count
xCount = ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Sheet Number").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Sheet Number").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Sheet Number").PivotItems.Count

Համար I = 1 To xCount
Եթե ​​ես <> xFilterStr1 Եվ ես <> xFilterStr2 Ապա
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Sheet Number").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Sheet Number").PivotItems(I).Visible = False
Ուրիշ
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Sheet Number").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Sheet Number").PivotItems(I).Visible = True
Վերջ: Եթե
հաջորդ

I = 1 To yCount-ի համար
Եթե ​​ես <> yFilterstr1 Եվ ես <> yfilterstr2 Ապա
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Sheet Number").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Sheet Number").PivotItems(I).Visible = False
Ուրիշ
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Sheet Number").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Sheet Number").PivotItems(I).Visible = True
Վերջ: Եթե
հաջորդ

Վերջ Sub

Բարև ՍՏ.
Ենթադրենք, որ ձեր թիրախային արժեքը 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

Բարև ՍՏ,
Ես այնքան էլ չեմ հասկանում, թե ինչ նկատի ունեք: Ձեր դեպքում D3 թիրախային բջիջի արժեքը օգտագործվում է առանցքային աղյուսակը զտելու համար: Թիրախային D3 բջիջի բանաձևը վկայակոչում է A15, B15 և C15 բջիջների արժեքները, որոնք կփոխվեն ըստ հղումային բջիջների արժեքների: Երբ A15-ի, B15-ի և C15-ի որևէ արժեք փոխվի, առանցքային աղյուսակը ավտոմատ կերպով կզտվի, եթե թիրախ բջիջի արժեքը համապատասխանում է առանցքային աղյուսակի ֆիլտրի պայմաններին: Եթե ​​թիրախային բջիջի արժեքը չի համապատասխանում առանցքային աղյուսակի զտման չափանիշներին, ապա առանցքային աղյուսակը ավտոմատ կերպով կվերակայվի առանց զտման:

Բարև Սագար Թ.
Կոդը թարմացվել է։ Խնդրում եմ, փորձեք: Շնորհակալություն Ձեր արձագանքի համար:
Մի մոռացեք փոխել աշխատանքային թերթիկի, առանցքային աղյուսակի և ֆիլտրի անվանումները կոդի մեջ: Կամ կարող եք ներբեռնել հետևյալ վերբեռնված աշխատանքային գիրքը թեստավորման համար:

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 աշխատաթերթի ներդիր, սեղմեք Դիտել կոդը աջ սեղմումով ընտրացանկից, այնուհետև ավելացրեք կոդը Թերթ 3 (կոդ) պատուհան.