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

كيفية ربط مرشح Pivot Table بخلية معينة في Excel؟

إذا كنت تريد ربط عامل تصفية Pivot Table بخلية معينة ، وجعل Pivot Table مصفيًا استنادًا إلى قيمة الخلية ، يمكن أن تساعدك الطريقة في هذه المقالة.

ربط عامل التصفية Pivot Table بخلية معينة برمز VBA


ربط عامل التصفية Pivot Table بخلية معينة برمز VBA

يجب أن يشتمل الجدول المحوري الذي ستقوم بربط وظيفة التصفية الخاصة به بقيمة خلية على حقل مرشح (يلعب اسم حقل المرشح دورًا مهمًا في التعليمات البرمجية لـ VBA التالية).

خذ الجدول المحوري أدناه كمثال ، يسمى حقل المرشح في Pivot Table الاختصاص، ويتضمن قيمتين "النفقات"و"المبيــعات". بعد ربط مرشح Pivot Table بخلية ، يجب أن تكون قيم الخلية التي ستطبقها على مرشح Pivot Table هي "المصاريف" و "المبيعات".

1. يرجى تحديد الخلية (هنا أقوم بتحديد الخلية H6) التي ستربطها بوظيفة مرشح Pivot Table ، وإدخال إحدى قيم التصفية في الخلية مقدمًا.

2. فتح ورقة العمل تحتوي على Pivot Table الذي ستربطه بالخلية. انقر بزر الماوس الأيمن فوق علامة تبويب الورقة وحدد عرض الرمز من قائمة السياق. انظر لقطة الشاشة:

3. في ال ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، انسخ رمز VBA أدناه في نافذة التعليمات البرمجية.

كود فبا: ربط عامل التصفية Pivot Table بخلية معينة

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

ملاحظة:

شنومكس) "Sheet1"هو اسم ورقة العمل المفتوحة.
شنومكس) "PivotTable2"هو اسم Pivot Table الذي ستقوم بربط وظيفة التصفية الخاصة به بخلية.
3) يسمى حقل التصفية في الجدول المحوري "الاختصاص".
4) الخلية المشار إليها هي H6. يمكنك تغيير هذه القيم المتغيرة بناءً على احتياجاتك.

4. اضغط على قديم + Q مفاتيح لإغلاق ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

الآن وظيفة مرشح Pivot Table مرتبطة بالخلية H6.

قم بتحديث الخلية H6 ، ثم يتم تصفية البيانات المقابلة في Pivot Table بناءً على القيمة الحالية. انظر لقطة الشاشة:

عند تغيير قيمة الخلية ، سيتم تغيير البيانات المصفاة في Pivot Table تلقائيًا. انظر لقطة الشاشة:


حدد الصفوف بأكملها بسهولة بناءً على قيمة الخلية في عمود موحد:

حدد خلايا معينة فائدة كوتولس ل إكسيل يمكن أن تساعدك في تحديد الصفوف بأكملها بسرعة بناءً على قيمة الخلية في عمود موحد في Excel كما هو موضح أدناه لقطة الشاشة. بعد تحديد جميع الصفوف بناءً على قيمة الخلية ، يمكنك نقلها يدويًا أو نسخها إلى موقع جديد كما تريد في Excel.
قم بتنزيله وجربه الآن! (30درب مجاني ليوم)


مقالات ذات صلة:


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (36)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيفية القيام بذلك على mul ؛ حقل tiple لأنه في الكود لا يوجد سوى هدف واحد
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا فرانك
لا يستطيع Sory مساعدتك في ذلك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
ماذا لو كانت الخلية المرتبطة بالجدول المحوري ، في هذه الحالة H6 ، موجودة في ورقة عمل أخرى؟ كيف يغير الرمز؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
ماذا لو كان لدي أكثر من جدول محوري ولربطه بخلية واحدة. كيف يمكنني تعديل الكود؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جيري ،
آسف لا أستطيع مساعدتك في ذلك. مرحبًا بك لنشر أي سؤال في منتدانا: https://www.extendoffice.com/forum.html للحصول على مزيد من دعم Excel من محترفي Excel أو غيرهم من محبي Excel.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
ابحث عنها وقم بتغييرها في Array () و Intersect () و Worksheets () و PivotFields ()

PivotTable1
PivotTable2
PivotTable3
PivotTable4
H1
اسم الورقة
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
تم تصغير هذا التعليق بواسطة المشرف على الموقع
بوا تارد ...! Ótima publicação ، como faço para utilizar o filtro em duas ou mais tabelas dinâmicas ...؟ Agradeço desde já.

طاب مسائك...! نشر رائع ، كيف يمكنني استخدام عامل التصفية في جدولين أو أكثر من جداول PivotTable ...؟ شكرا لك مقدما.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا جيلمار ألفيس ،
آسف لا أستطيع مساعدتك في ذلك. مرحبًا بك لنشر أي سؤال في منتدانا: https://www.extendoffice.com/forum.html للحصول على مزيد من دعم Excel من محترفي Excel أو غيرهم من محبي Excel.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل اكتشف أي شخص سؤال ربط الجدول المحوري المتعدد؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
تغيير القيم في Array () و Worksheets () و Intersect ()



** ابحث عن هذه وقم بتغييرها **
اسم الورقة
E1
PivotTable1
PivotTable2
PivotTable3




ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
'تحديث بواسطة Extendoffice 20180702
خافت xPTable كـ PivotTable
خافت xP: ملف كـ PivotField

خافت xPTabled كـ PivotTable
خافت xP تم تصنيفها كـ PivotField

خافت xStr كسلسلة



على خطأ استئناف التالي

리스트 만들기
قائمة قاتمة: صفيف () كمتغير
listArray = صفيف ("PivotTable1" ، "PivotTable2" ، "PivotTable3")



إذا تقاطع (الهدف ، النطاق ("E1")) لا شيء ، ثم اخرج من الفرع الفرعي
Application.ScreenUpdating = خطأ

بالنسبة إلى i = 0 إلى UBound (listArray)

Set xPTable = Worksheets ("SheetName"). PivotTables (listArray (i))
تعيين xPFile = xPTable.PivotFields ("Company_ID")

xStr = الهدف
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



التالى

Application.ScreenUpdating = ترو



نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Ciao ، sto provando a fare lo stesso esempio per far in modo che il filtro della pivot si sul valore della cella ،
non riesco a farla funzionare.

Quale passaggio manca nella وصف سوبرا؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
هل تلقيت أي خطأ موجه؟ أحتاج إلى معرفة أكثر تحديدًا حول مشكلتك ، مثل إصدار Excel الخاص بك. وإذا كنت لا تمانع ، فحاول إنشاء بياناتك في كتاب عمل جديد وجرب agai ، أو التقط لقطة شاشة لبياناتك وقم بتحميلها هنا.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،

حاولت تشغيل هذا لمرشح العمود ولكن لا يبدو أنه يعمل. هل أحتاج إلى رمز آخر لذلك؟

شكر
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جستن،
هل تلقيت أي خطأ موجه؟ أحتاج إلى معرفة أكثر تحديدًا حول مشكلتك.
قبل تطبيق الكود ، لا تنس تعديل "اسم الورقة""اسم الجدول المحوري""اسم مرشح الجدول المحوري" و ال الخلية تريد تصفية الجدول المحوري بناءً على (انظر sceenshot).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،

شكرا لمساعدتك. المشكلة هي أن الوظيفة لا تفعل شيئًا لسبب ما. بعض الإيضاحات:

الاسم المحوري: Order_Comp_B2C
اسم الورقة: ورقة الحساب
اسم الفلتر: رقم الأسبوع (لقد غيرت هذا الاسم مما كان عليه "إرسال أسبوع لا" في ملف البيانات)
الخلية المطلوب تغييرها: O26 و O27 (يجب أن يكون هذا في النطاق)

في هذا المحور ، أحاول تغيير عامل التصفية للأعمدة ، وليس لدي أي شيء في منطقة التصفية في قائمة حقول PivotTable.

الكود الخاص بي هو:

ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
'تحديث بواسطة Extendoffice 20180702
خافت xPTable كـ PivotTable
خافت xP: ملف كـ PivotField
خافت xStr كسلسلة
على خطأ استئناف التالي
إذا كان التقاطع (الهدف ، النطاق ("O26")) لا شيء ، فاخرج من المنطقة الفرعية
Application.ScreenUpdating = خطأ
Set xPTable = Worksheets ("Calculation Sheet"). PivotTables ("Order_Comp_B2C")
تعيين xPFile = xPTable.PivotFields ("رقم الأسبوع")
xStr = الهدف
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = ترو
نهاية الفرعية

شكر،

جوستين
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا جاستن تيو ،
لقد غيرت ال اسم المحور, اسم الورقة, اسم المرشح و خلية للتغيير وفقًا للشروط التي ذكرتها أعلاه ، وجربت رمز VBA الذي قدمته ، فهو يعمل بشكل جيد في حالتي. راجع ملف GIF التالي أو المصنف المرفق.
هل تمانع في إنشاء مصنف جديد وجرب الكود مرة أخرى؟
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،

أرفق لقطة شاشة للمحور ، المربع الأحمر هو المرشح الذي أرغب في تغييره بناءً على قيمة الخلية.

على نحو مفضل ، أرغب في استخدام مجموعة من الخلايا تشير إلى عدة أرقام أسبوع.

شكر،

جوستين
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جستن،
آسف لم أر لقطة الشاشة التي أرفقتها على الصفحة. ربما هناك خطأ ما في الصفحة.
إذا كنت لا تزال بحاجة إلى حل المشكلة ، راسلني عبر البريد الإلكتروني zxm@addin99.com. آسف للإزعاج.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جاستن تيو ,
يرجى تجربة كود فبا التالي. آمل أن أتمكن من المساعدة.

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. ربما أحتاج إلى تغييره قليلاً؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا maziaritib4 TIB ،
هذه الطريقة متاحة فقط لبرنامج Microsoft Excel. آسف للإزعاج.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جستن،

لقد نجح هذا بشكل مثالي ، ومع ذلك ، أتساءل عما إذا كان يمكن تطبيق هذه القاعدة على جداول PivotTable متعددة داخل نفس الورقة؟

شكر،
جيمس
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جيمس،

نعم ، هذا ممكن ، الكود الذي استخدمته لهذا هو (4 محاور ومراجع خليتين):

ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
خافت أنا كعدد صحيح
Dim xFilterStr1، xFilterStr2، yFilterstr1، yfilterstr2 كسلسلة
على خطأ استئناف التالي
إذا تقاطع (الهدف ، النطاق ("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 = "" ثم اخرج من 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 = صحيح

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

لأني = 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
إنهاء حالة
التالى

لأني = 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
إنهاء حالة
التالى

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
تغيير القيم في Array () و Worksheets () و Intersect ()



** ابحث عن هذه وقم بتغييرها **
اسم الورقة
E1
PivotTable1
PivotTable2
PivotTable3




ورقة عمل فرعية خاصة تغيير (هدف ByVal كنطاق)
'تحديث بواسطة Extendoffice 20180702
خافت xPTable كـ PivotTable
خافت xP: ملف كـ PivotField

خافت xPTabled كـ PivotTable
خافت xP تم تصنيفها كـ PivotField

خافت xStr كسلسلة



على خطأ استئناف التالي

리스트 만들기
قائمة قاتمة: صفيف () كمتغير
listArray = صفيف ("PivotTable1" ، "PivotTable2" ، "PivotTable3")



إذا تقاطع (الهدف ، النطاق ("E1")) لا شيء ، ثم اخرج من الفرع الفرعي
Application.ScreenUpdating = خطأ

بالنسبة إلى i = 0 إلى UBound (listArray)

Set xPTable = Worksheets ("SheetName"). PivotTables (listArray (i))
تعيين xPFile = xPTable.PivotFields ("Company_ID")

xStr = الهدف
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



التالى

Application.ScreenUpdating = ترو



نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،

الكود يعمل بشكل جيد بالنسبة لي. ومع ذلك ، لا يمكنني الحصول على الجدول المحوري لتحديث هدف المرشح تلقائيًا. الهدف في حالتي هو صيغة [DATE (D18، S14، C18)]. يعمل الكود فقط عندما أنقر مرتين على الخلية المستهدفة واضغط على Enter.

شكراً لك
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،

هذا الرمز يعمل بشكل مثالي. ومع ذلك ، لا يمكنني الحصول على الكود لتحديث الجدول المحوري تلقائيًا. القيمة المستهدفة بالنسبة لي هي صيغة (= DATE (D18، ..، ..)) تتغير بناءً على ما يتم تحديده في D18. لتحديث الجدول المحوري ، يتعين علي النقر نقرًا مزدوجًا فوق الخلية المستهدفة والضغط على إدخال. هل هناك طريقة للتغلب عليها؟

شكراً لك
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا 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

لا يقوم الرمز تلقائيًا بإعادة تعيين التواريخ عند تغيير الهدف. لدي ملف إكسل ينسخ ما أحاول القيام به ، ولكني غير قادر على إضافة مرفقات على هذا الموقع. D3 (الهدف = DATE (A15، B15، C15)) لها معادلة مرتبطة بـ A15 و B15 و C15. عندما يتم تغيير أي قيمة في A15 و B15 و C15 ، يتم إعادة تعيين الجدول المحوري إلى أي مرشح. هل يمكنك مساعدتي في هذا؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ST ،
أنا لا أفهم تماما ما تعنيه. في حالتك ، يتم استخدام قيمة الخلية المستهدفة D3 لتصفية الجدول المحوري. تشير الصيغة الموجودة في الخلية المستهدفة D3 إلى قيم الخلايا A15 و B15 و C15 ، والتي ستتغير وفقًا للقيم الموجودة في الخلايا المرجعية. عند تغيير أي قيمة في A15 و B15 و C15 ، ستتم تصفية الجدول المحوري تلقائيًا إذا كانت القيمة في الخلية الهدف تفي بشروط التصفية للجدول المحوري. إذا كانت القيمة الموجودة في الخلية الهدف لا تفي بمعايير تصفية الجدول المحوري ، فسيتم إعادة تعيين الجدول المحوري تلقائيًا إلى عدم التصفية.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لست متأكدًا مما إذا كانت هناك طريقة لمشاركة ملف Excel معك. إذا كانت القيمة المستهدفة ، وهي تاريخ ، تتغير وفقًا للتغييرات في الخلايا الأخرى. لا بد لي من النقر نقرًا مزدوجًا فوق الخلية المستهدفة والضغط على مفتاح الإدخال (كما تفعل بعد إدخال صيغة في خلية) لتحديث الجدول المحوري
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا 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 () و PivotFields ()

PivotTable1
PivotTable2
PivotTable3
PivotTable4
H1
اسم الورقة
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
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل تريد قراءة المزيد؟ а не 2 как в примере؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا Алексей ،

يرجى التحقق مما إذا كان رمز VBA في هذا التعليق #38754 يمكن أن تساعد.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل تريد أن تتعلم كيفية استخدام H6؟ как это сделать؟ подскажите пожалуйста.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا Алексей ،

لا تحتاج إلى تعديل الكود ، ما عليك سوى إضافة رمز VBA إلى ورقة عمل الخلية التي تريد الرجوع إليها.
على سبيل المثال ، إذا كنت تريد تصفية جدول محوري باسم "PivotTable1"في Sheet2 بناءً على قيمة الخلية H6 in Sheet3، يرجى النقر بزر الماوس الأيمن فوق Sheet3 علامة تبويب ورقة العمل ، انقر فوق عرض الرمز من قائمة النقر بزر الماوس الأيمن ، ثم أضف الرمز إلى ملف الورقة 3 (الرمز) نافذة.
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL