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

Ինչպե՞ս առանցքային աղյուսակի զտիչը կապել Excel- ի որոշակի բջջի հետ:

Եթե ​​ցանկանում եք առանցքային աղյուսակի զտիչը կապել որոշակի բջիջի հետ և առանցքային աղյուսակը զտել բջջային արժեքի հիման վրա, ապա այս հոդվածի մեթոդը կարող է օգնել ձեզ:

Կապեք առանցքային աղյուսակի զտիչը VBA կոդով որոշակի բջիջի հետ


Կապեք առանցքային աղյուսակի զտիչը VBA կոդով որոշակի բջիջի հետ

Առանցք աղյուսակը, որը դուք կապելու եք դրա զտիչի գործառույթը բջջային արժեքի հետ, պետք է ներառի զտիչի դաշտ (ֆիլտրի դաշտի անվանումը կարևոր դեր է խաղում հետևյալ VBA կոդում):

Վերցրեք ստորև նշված առանցքային աղյուսակը որպես օրինակ, առանցքային աղյուսակում զտիչի դաշտը կոչվում է կատեգորիա, և այն իր մեջ ներառում է երկու արժեք «Ծախսեր"Եւ"Sales» Առանց աղյուսակի զտիչը բջիջին կապելուց հետո բջջային արժեքները, որոնք դուք կկիրառեք առանցքային աղյուսակը զտելու համար, պետք է լինեն «ensesախսեր» և «Վաճառք»:

1. Խնդրում ենք ընտրել այն բջիջը (այստեղ ես ընտրում եմ H6 բջիջը), որը դուք կուղեկցեք առանցքային աղյուսակի ֆիլտրի գործառույթին և ֆիլտրի արժեքներից մեկը նախապես մուտքագրեք բջիջ:

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

Notes:

1) "Sheet1”- բացված աշխատանքային թերթի անվանումն է:
2) "Առանցքային աղյուսակ 2”Առանցքային աղյուսակի անունն է, որը դուք կապելու եք դրա զտիչի գործառույթը բջիջի հետ:
3) առանցքային աղյուսակում զտիչ դաշտը կոչվում է. "կատեգորիա".
4) Հղված բջիջը H6 է: Կարող եք փոխել այս փոփոխական արժեքները ՝ ելնելով ձեր կարիքներից:

4. Սեղմեք ալտ + Q ստեղները փակելու համար Microsoft Visual Basic հավելվածների համար պատուհան.

Այժմ առանցքային աղյուսակի զտիչի գործառույթը կապված է H6 բջիջի հետ:

Թարմացրեք H6 բջիջը, այնուհետև առանցքային աղյուսակում համապատասխան տվյալները զտվում են ՝ ելնելով առկա արժեքից: Տեսեք,

Բջջի արժեքը փոխելիս առանցքային աղյուսակում զտված տվյալները ավտոմատ կերպով կփոխվեն: Տեսեք,


Հեշտությամբ ընտրեք ամբողջ տողերը `հիմնվելով վավերացված սյունակում բջիջների արժեքի վրա.

The Ընտրեք հատուկ բջիջներ օգտակարությունը Excel- ի համար նախատեսված գործիքներ կարող է օգնել ձեզ արագ ընտրել ամբողջ տողերը ՝ հիմնված բջջային արժեքի վրա Excel- ի հավաստագրային սյունակում, ինչպես ցույց է տրված նկարում: Բջջային արժեքի հիման վրա բոլոր տողերն ընտրելուց հետո կարող եք ձեռքով տեղափոխել կամ պատճենել դրանք նոր վայրում, ինչպես ձեզ հարկավոր է Excel- ում:
Ներբեռնեք և փորձեք հիմա: (30- օր անվճար երթուղի)


Առնչվող հոդվածներ քանակը:


Գրասենյակի արտադրողականության լավագույն գործիքները

Excel-ի համար Kutools-ը լուծում է ձեր խնդիրների մեծ մասը և բարձրացնում ձեր արտադրողականությունը 80%-ով

  • Վերաօգտագործել: Արագ տեղադրեք բարդ բանաձևեր, գծապատկերներ և այն ամենը, ինչ դուք նախկինում օգտագործել եք. Ryածկագրել բջիջները գաղտնաբառով; Ստեղծեք փոստային ցուցակ և նամակներ ուղարկել ...
  • Super Formula Bar (հեշտությամբ խմբագրեք տեքստի և բանաձևի բազմաթիվ տողեր); Ընթերցանության դասավորությունը (հեշտությամբ կարդալ և խմբագրել մեծ թվով բջիջներ); Տեղադրել ֆիլտրացված տիրույթում...
  • Միաձուլել բջիջները / տողերը / սյունակները առանց տվյալների կորստի. Պառակտված բջիջների պարունակությունը; Միավորել կրկնօրինակ տողերը / սյունակները... Կանխել կրկնօրինակ բջիջները; Համեմատեք միջակայքերը...
  • Ընտրեք Կրկնօրինակ կամ Եզակի Շարքեր; Ընտրեք դատարկ շարքեր (բոլոր բջիջները դատարկ են); Super Find և Fuzzy Find շատ աշխատանքային գրքույկներում; Պատահական ընտրություն ...
  • Actշգրիտ պատճեն Բազմաթիվ բջիջներ ՝ առանց բանաձևի հղումը փոխելու; Ավտոմատ ստեղծեք հղումներ դեպի մի քանի թերթեր; Տեղադրեք փամփուշտներ, Տուփեր և ավելին ...
  • Քաղվածք տեքստ, Տեքստ ավելացնել, հեռացնել ըստ դիրքի, Հեռացնել տարածությունը; Ստեղծել և տպել էջային ենթագոտիներ; Փոխարկել բջիջների բովանդակության և մեկնաբանությունների միջև...
  • Սուպեր զտիչ (պահպանել և կիրառել ֆիլտրի սխեմաները այլ թերթերի վրա); Ընդլայնված տեսակավորում ըստ ամիս / շաբաթ / օր, հաճախականություն և ավելին; Հատուկ զտիչ համարձակ, շեղատառով ...
  • Միավորել աշխատանքային տետրերը և աշխատանքային թերթերը; Միավորել աղյուսակները ՝ հիմնված հիմնական սյունակների վրա; Տվյալները բաժանեք մի քանի թերթերի; Խմբաքանակի փոխակերպում xls, xlsx և PDF...
  • Ավելի քան 300 հզոր հատկություններ. Աջակցում է Office / Excel 2007-2021 և 365: Աջակցում է բոլոր լեզուներին: Հեշտ տեղակայում ձեր ձեռնարկությունում կամ կազմակերպությունում: Ամբողջական հնարավորություններ 30-օրյա անվճար փորձարկում: 60-օրյա գումարի վերադարձի երաշխիք:
kte էջանիշը 201905

Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք

  • Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
  • Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
  • Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
officetab ներքևում
Տեսակավորել մեկնաբանությունները ըստ
մեկնաբանություններ (36)
Դեռևս գնահատականներ չկան: Եղիր առաջինը, ով կգնահատի:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
ինչպես դա անել mul;tiple դաշտում, քանի որ կոդում կա միայն մեկ թիրախ
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ֆրենկ
Սորին չի կարող ձեզ օգնել այդ հարցում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Իսկ եթե բջիջը, որը կապված է Pivot Table-ի հետ, այս դեպքում՝ H6-ը, գտնվում է մեկ այլ աշխատաթերթում: Ինչպե՞ս է այն փոխում կոդը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
ինչ կլինի, եթե ես ունեմ 1-ից ավելի առանցքային աղյուսակ և կապել 1 բջիջի: Ինչպե՞ս կարող եմ փոփոխել կոդը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ջերի,
Կներեք, չեմ կարող օգնել ձեզ այդ հարցում: Բարի գալուստ ցանկացած հարց տեղադրել մեր ֆորումում. 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
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բոա թարդե... Ótima publicação, como faço para utilizar o filtro em duas ou mais tabelas dinâmicas...? Agradeço desde já.

Բարի օր...! Հրաշալի հրապարակում, ինչպե՞ս կարող եմ օգտագործել զտիչը երկու կամ ավելի առանցքային աղյուսակներում…: Նախապես շնորհակալություն.
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Գիլմար Ալվես,
Կներեք, չեմ կարող օգնել ձեզ այդ հարցում: Բարի գալուստ ցանկացած հարց տեղադրել մեր ֆորումում. https://www.extendoffice.com/forum.html Excel-ի մասնագետներից կամ Excel-ի այլ երկրպագուներից ավելի շատ Excel աջակցություն ստանալու համար:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Որևէ մեկը պարզե՞լ է բազմակի առանցքային աղյուսակը կապող հարցը:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Փոխեք արժեքները Array(), Worksheets() և Intersect()-ում



**Գտեք դրանք և փոխեք այն**
Թերթի Անուն
E1
Առանցքային աղյուսակ 1
Առանցքային աղյուսակ 2
Առանցքային աղյուսակ 3




Private Sub Worksheet_Change (ByVal Target as Range)
«Թարմացվել է Extendoffice 20180702
Dim xPTable Որպես PivotTable
Խոնավեցրեք xPFile-ը որպես առանցքային դաշտ

Dim xPTabled As PivotTable
Dim xPFiled As PivotField

Dim xStr Որպես տող



Ս.թ. սխալի Ռեզյումե Next

'리스트 만들기
Dim listArray() Որպես տարբերակ
listArray = Array ("PivotTable1", "PivotTable2", "PivotTable3")



Եթե ​​խաչմերուկը (Թիրախ, միջակայք («E1»)) ոչինչ չէ, ապա դուրս եկեք ենթակետից
Դիմում. ScreenUpdating = Սուտ է

i = 0-ի համար դեպի UBound (listArray)

Սահմանել xPTable = Worksheets ("SheetName"). PivotTables (listArray(i))
Սահմանել xPFile = xPTable.PivotFields («Ընկերության_ID»)

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



հաջորդ

Դիմում. ScreenUpdating = ueիշտ է



Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ciao, 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.

Որո՞նք են passaggio manca nella descrizione sopra?
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն,
Ինչ-որ սխալի հուշում ստացե՞լ եք: Ես պետք է ավելի կոնկրետ իմանամ ձեր խնդրի մասին, օրինակ՝ ձեր Excel տարբերակը: Եվ եթե դեմ չեք, փորձեք ստեղծել ձեր տվյալները նոր աշխատանքային գրքում և նորից փորձեք, կամ վերցրեք ձեր տվյալների սքրինշոթը և վերբեռնեք այստեղ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջու՜յն,

Փորձեցի սյունակի ֆիլտրի համար սա աշխատել, բայց կարծես թե չի աշխատում: Ինձ այլ կոդ է պետք դրա համար:

Շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ջասթին,
Ստացե՞լ եք որևէ սխալի հուշում: Ես պետք է ավելի կոնկրետ իմանամ ձեր խնդրի մասին:
Նախքան կոդը կիրառելը, մի մոռացեք փոփոխել «թերթիկի անվանումը""առանցքային աղյուսակի անվանումը""առանցքային աղյուսակի ֆիլտրի անվանումը" եւ բջիջ դուք ցանկանում եք զտել առանցքային աղյուսակը հիմնվելով (տե՛ս նկարը):
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Կրիստալ,

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

Առանցքային անվանումը՝ 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-ը կամ կից աշխատանքային գրքույկը։
Դեմ ե՞ք ստեղծել նոր աշխատանքային գրքույկ և նորից փորձել կոդը:
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.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
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես այն օգտագործեցի նորմալ Excel-ի համար և այն աշխատեց: Բայց ես չէի կարող օգտագործել այն olap աշխատանքային թերթիկների համար: միգուցե պետք է մի փոքր փոխել?
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ողջույն maziaritib4 TIB,
Մեթոդը հասանելի է միայն Microsoft Excel-ի համար: Ներողություն անհանգստության համար.
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ջասթին,

Սա հիանալի է աշխատել, այնուամենայնիվ, ինձ հետաքրքրում է, թե արդյոք այս կանոնը կարող է կիրառվել միևնույն թերթիկի մի քանի առանցքային աղյուսակների վրա:

Thanks,
James
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
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
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Փոխեք արժեքները Array(), Worksheets() և Intersect()-ում



**Գտեք դրանք և փոխեք այն**
Թերթի Անուն
E1
Առանցքային աղյուսակ 1
Առանցքային աղյուսակ 2
Առանցքային աղյուսակ 3




Private Sub Worksheet_Change (ByVal Target as Range)
«Թարմացվել է Extendoffice 20180702
Dim xPTable Որպես PivotTable
Խոնավեցրեք xPFile-ը որպես առանցքային դաշտ

Dim xPTabled As PivotTable
Dim xPFiled As PivotField

Dim xStr Որպես տող



Ս.թ. սխալի Ռեզյումե Next

'리스트 만들기
Dim listArray() Որպես տարբերակ
listArray = Array ("PivotTable1", "PivotTable2", "PivotTable3")



Եթե ​​խաչմերուկը (Թիրախ, միջակայք («E1»)) ոչինչ չէ, ապա դուրս եկեք ենթակետից
Դիմում. ScreenUpdating = Սուտ է

i = 0-ի համար դեպի UBound (listArray)

Սահմանել xPTable = Worksheets ("SheetName"). PivotTables (listArray(i))
Սահմանել xPFile = xPTable.PivotFields («Ընկերության_ID»)

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



հաջորդ

Դիմում. ScreenUpdating = ueիշտ է



Վերջ Sub
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ,

Կոդն ինձ մոտ լավ է աշխատում: Այնուամենայնիվ, ես չեմ կարողանում ստանալ առանցքային աղյուսակը, որպեսզի ավտոմատ կերպով թարմացվի ֆիլտրի թիրախը: Իմ դեպքում թիրախը բանաձևն է [DATE(D18,S14,C18)]: Կոդն աշխատում է միայն այն դեպքում, երբ ես կրկնակի սեղմում եմ թիրախային բջիջը և սեղմում Enter:

Շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարեւ,

Այս կոդը հիանալի է աշխատում: Այնուամենայնիվ, ես չեմ կարողանում ստանալ առանցքային աղյուսակը ավտոմատ կերպով թարմացնելու կոդը: Ինձ համար թիրախային արժեքը բանաձև է (=DATE(D18,..,..)), որը փոխվում է՝ կախված նրանից, թե ինչ է ընտրված D18-ում: Որպեսզի այն թարմացնի առանցքային աղյուսակը, ես պետք է կրկնակի սեղմեմ թիրախային բջիջի վրա և սեղմեմ Enter: Արդյո՞ք դրա շուրջ ճանապարհ կա:

Շնորհակալություն
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև ՍՏ.
Ենթադրենք, որ ձեր թիրախային արժեքը 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 ֆայլ, որը կրկնում է այն, ինչ փորձում եմ անել, սակայն ես չեմ կարող այս կայքում հավելվածներ ավելացնել: D3 (նպատակ = DATE(A15,B15,C15)) ունի հավասարում, որը կապված է A15, B15 և C15 հետ: Երբ A15-ի, B15-ի և C15-ի որևէ արժեք փոխվում է, առանցքային աղյուսակը վերակայվում է առանց զտիչի: Կարո՞ղ եք ինձ օգնել այս հարցում:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև ՍՏ,
Ես այնքան էլ չեմ հասկանում, թե ինչ նկատի ունեք: Ձեր դեպքում D3 թիրախային բջիջի արժեքը օգտագործվում է առանցքային աղյուսակը զտելու համար: Թիրախային D3 բջիջի բանաձևը վկայակոչում է A15, B15 և C15 բջիջների արժեքները, որոնք կփոխվեն ըստ հղումային բջիջների արժեքների: Երբ A15-ի, B15-ի և C15-ի որևէ արժեք փոխվի, առանցքային աղյուսակը ավտոմատ կերպով կզտվի, եթե թիրախ բջիջի արժեքը համապատասխանում է առանցքային աղյուսակի ֆիլտրի պայմաններին: Եթե ​​թիրախային բջիջի արժեքը չի համապատասխանում առանցքային աղյուսակի զտման չափանիշներին, ապա առանցքային աղյուսակը ավտոմատ կերպով կվերակայվի առանց զտման:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Ես վստահ չեմ, թե արդյոք կա Excel ֆայլով ձեզ հետ կիսելու միջոց: Եթե ​​իմ թիրախային արժեքը, որը ամսաթիվ է, փոխվում է այլ բջիջների փոփոխությունների համաձայն: Ես պետք է կրկնակի սեղմեմ թիրախային բջիջի վրա և սեղմեմ Enter (ինչպես դուք կկատարեիք բջիջում բանաձև մուտքագրելուց հետո)՝ առանցքային աղյուսակը թարմացնելու համար։
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Սագար Թ.
Կոդը թարմացվել է։ Խնդրում եմ, փորձեք: Շնորհակալություն Ձեր արձագանքի համար:
Մի մոռացեք փոխել աշխատանքային թերթիկի, առանցքային աղյուսակի և ֆիլտրի անվանումները կոդի մեջ: Կամ կարող եք ներբեռնել հետևյալ վերբեռնված աշխատանքային գիրքը թեստավորման համար:

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(), 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
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек? չէ՞ 1 ինչպես օրինակ:
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ալեքսանդր,

Խնդրում ենք ստուգել՝ արդյոք VBA կոդը այս մեկնաբանության մեջ է #38754 կարող է օգնել.
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе? ինչպես это сделать? подскажите пожалуйста.
Այս մեկնաբանությունը կայքի վարողի կողմից նվազագույնի է հասցվել
Բարև Ալեքսանդր,

Ձեզ հարկավոր չէ փոխել կոդը, պարզապես ավելացրեք VBA կոդը այն բջջի աշխատաթերթում, որին ցանկանում եք հղում կատարել:
Օրինակ, եթե ցանկանում եք զտել առանցքային աղյուսակը «Առանցքային աղյուսակ 1» Sheet2 հիմնված բջջի արժեքի վրա H6 in Sheet3, խնդրում ենք սեղմել աջը Sheet3 աշխատաթերթի ներդիր, սեղմեք Դիտել կոդը աջ սեղմումով ընտրացանկից, այնուհետև ավելացրեք կոդը Թերթ 3 (կոդ) պատուհան.
Առայժմ ոչ մի մեկնաբանություն չկա

Հետեւեք մեզ

Հեղինակային իրավունքի © 2009 - www.extendoffice.com. | Բոլոր իրավունքները պաշտպանված են. Powered by ExtendOffice. | | Կայքի քարտեզ
Microsoft- ը և Office- ի պատկերանշանը հանդիսանում են Microsoft Corporation- ի ապրանքային նշաններ կամ գրանցված ապրանքային նշաններ ԱՄՆ-ում և (կամ) այլ երկրներում:
Պաշտպանված է Sectigo SSL- ի կողմից