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

วิธีเชื่อมโยงตัวกรองตาราง Pivot กับเซลล์บางเซลล์ใน Excel

หากคุณต้องการเชื่อมโยงตัวกรองตาราง Pivot กับเซลล์บางเซลล์และทำให้ตาราง Pivot ถูกกรองตามค่าของเซลล์วิธีการในบทความนี้สามารถช่วยคุณได้

เชื่อมโยงตัวกรองตาราง Pivot กับเซลล์บางเซลล์ด้วยรหัส VBA


เชื่อมโยงตัวกรองตาราง Pivot กับเซลล์บางเซลล์ด้วยรหัส VBA

ตาราง Pivot ที่คุณจะเชื่อมโยงฟังก์ชันตัวกรองกับค่าของเซลล์ควรมีฟิลด์ตัวกรอง (ชื่อของฟิลด์ตัวกรองมีบทบาทสำคัญในโค้ด VBA ต่อไปนี้)

ใช้ตาราง Pivot ด้านล่างเป็นตัวอย่างฟิลด์ตัวกรองในตาราง Pivot เรียกว่า หมวดหมู่และมีสองค่า "รายจ่าย"และ"ขาย”. หลังจากเชื่อมโยงตัวกรองตาราง Pivot กับเซลล์แล้วค่าของเซลล์ที่คุณจะนำไปใช้กับตัวกรองตาราง Pivot ควรเป็น "ค่าใช้จ่าย" และ "ยอดขาย"

1. โปรดเลือกเซลล์ (ที่นี่ฉันเลือกเซลล์ H6) คุณจะเชื่อมโยงไปยังฟังก์ชันตัวกรองของ Pivot Table และป้อนค่าตัวกรองค่าใดค่าหนึ่งลงในเซลล์ล่วงหน้า

2. เปิดแผ่นงานที่มีตาราง Pivot ที่คุณจะลิงก์ไปยังเซลล์ คลิกขวาที่แท็บแผ่นงานแล้วเลือก ดูรหัส จากเมนูบริบท ดูภาพหน้าจอ:

3 ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน คัดลอกโค้ด VBA ด้านล่างลงในหน้าต่าง Code

รหัส VBA: ลิงก์ตัวกรองตาราง Pivot กับเซลล์บางเซลล์

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) "PivotTable 2” คือชื่อของ Pivot Table ที่คุณจะเชื่อมโยงฟังก์ชันตัวกรองกับเซลล์
3) ฟิลด์การกรองในตาราง Pivot เรียกว่า "หมวดหมู่".
4) เซลล์ที่อ้างอิงคือ H6 คุณสามารถเปลี่ยนค่าตัวแปรเหล่านี้ตามความต้องการของคุณ

4 กด อื่น ๆ + Q ปุ่มเพื่อปิดไฟล์ Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

ตอนนี้ฟังก์ชันตัวกรองของ Pivot Table เชื่อมโยงกับเซลล์ H6

รีเฟรชเซลล์ H6 จากนั้นข้อมูลที่เกี่ยวข้องใน Pivot Table จะถูกกรองออกตามค่าที่มีอยู่ ดูภาพหน้าจอ:

เมื่อเปลี่ยนค่าเซลล์ข้อมูลที่กรองแล้วในตาราง Pivot จะเปลี่ยนโดยอัตโนมัติ ดูภาพหน้าจอ:


เลือกแถวทั้งหมดตามค่าของเซลล์ในคอลัมน์ผู้รับรอง:

พื้นที่ เลือกเซลล์เฉพาะ ประโยชน์ของ Kutools สำหรับ Excel สามารถช่วยคุณเลือกแถวทั้งหมดได้อย่างรวดเร็วตามค่าของเซลล์ในคอลัมน์ผู้รับรองใน Excel ดังภาพด้านล่าง หลังจากเลือกแถวทั้งหมดตามค่าของเซลล์แล้วคุณสามารถย้ายหรือคัดลอกไปยังตำแหน่งใหม่ได้ด้วยตนเองตามที่คุณต้องการใน Excel
ดาวน์โหลดและทดลองใช้เลย! (เส้นทางฟรี 30 วัน)


บทความที่เกี่ยวข้อง:


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel ช่วยแก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office / Excel 2007-2019 และ 365 รองรับทุกภาษา ใช้งานง่ายในองค์กรหรือองค์กรของคุณ ทดลองใช้ฟรี 30 วันเต็ม รับประกันคืนเงิน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มผลผลิตของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (32)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
วิธีทำบน mul;tiple field เนื่องจากในโค้ดมีเพียงหนึ่งเป้าหมาย
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีแฟรงค์
โซรีช่วยอะไรคุณไม่ได้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
จะเกิดอะไรขึ้นถ้าเซลล์ที่เชื่อมโยงกับ Pivot Table ในกรณีนี้คือ H6 อยู่บนเวิร์กชีตอื่น มันเปลี่ยนรหัสได้อย่างไร?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
จะเกิดอะไรขึ้นหากฉันมีตารางเดือยมากกว่า 1 ตารางและลิงก์ไปยัง 1 เซลล์ ฉันจะแก้ไขรหัสได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี เจอรี่
ขออภัยไม่สามารถช่วยคุณในเรื่องนั้นได้ ยินดีต้อนรับสู่การโพสต์คำถามใด ๆ ในฟอรัมของเรา: https://www.extendoffice.com/forum.html เพื่อรับการสนับสนุน Excel เพิ่มเติมจากผู้ใช้ Excel มืออาชีพหรือผู้ชื่นชอบ Excel คนอื่นๆ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ค้นหาสิ่งเหล่านี้และเปลี่ยนเป็น Array(),Intersect(), Worksheets(), PivotFields()

PivotTable 1
PivotTable 2
PivotTable 3
PivotTable 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...? อาเกรดโซ เด จา

สวัสดีตอนบ่าย...! การเผยแพร่ที่ยอดเยี่ยม ฉันจะใช้ตัวกรองใน PivotTable สองรายการขึ้นไปได้อย่างไร ... ขอบคุณล่วงหน้า.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี กิลมาร์ อัลเวส
ขออภัยไม่สามารถช่วยคุณในเรื่องนั้นได้ ยินดีต้อนรับสู่การโพสต์คำถามใด ๆ ในฟอรัมของเรา: https://www.extendoffice.com/forum.html เพื่อรับการสนับสนุน Excel เพิ่มเติมจากผู้ใช้ Excel มืออาชีพหรือผู้ชื่นชอบ Excel คนอื่นๆ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มีใครคิดคำถามเกี่ยวกับการเชื่อมโยงตารางเดือยหลายอันหรือไม่
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เปลี่ยนค่าใน Array(), Worksheets() และ Intersect()



** ค้นหาสิ่งเหล่านี้และเปลี่ยนแปลง **
ชื่อแผ่น
E1
PivotTable 1
PivotTable 2
PivotTable 3




Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
'อัพเดทโดย Extendoffice 20180702
Dim xPTable เป็น PivotTable
หรี่ xPFile เป็น PivotField

Dim xPTabled เป็น PivotTable
Dim xPยื่นเป็น PivotField

Dim xStr เป็นสตริง



เกี่ยวกับข้อผิดพลาดต่อไป

'รีสสท 만들기
Dim listArray() เป็น Variant
listArray = Array("PivotTable1", "PivotTable2", "PivotTable3")



ถ้า Intersect(Target, Range("E1")) ไม่มีอะไรก็ให้ออกจาก Sub
Application.ScreenUpdating = เท็จ

สำหรับ i = 0 ถึง UBound(listArray)

ตั้งค่า xPTable = แผ่นงาน ("ชื่อแผ่นงาน") PivotTables (listArray (i))
ตั้งค่า xPFile = xPTable.PivotFields("Company_ID")

xStr = เป้าหมาย ข้อความ
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



ต่อไป

Application.ScreenUpdating = จริง



ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Ciao, sto provando ค่าโดยสาร lo stesso esempio per far in modo che il filtro della pivot si setti sul valore della cella,
ไม่ใช่ riesco และ farla funzionare

Quale passaggio manca nella descrizione sopra?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
คุณได้รับข้อความแจ้งข้อผิดพลาดหรือไม่? ฉันต้องการทราบเฉพาะเจาะจงมากขึ้นเกี่ยวกับปัญหาของคุณ เช่น เวอร์ชัน Excel ของคุณ และถ้าคุณไม่รังเกียจ ให้ลองสร้างข้อมูลของคุณในเวิร์กบุ๊กใหม่และลองใช้อีกครั้ง หรือถ่ายภาพหน้าจอของข้อมูลของคุณแล้วอัปโหลดที่นี่
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี

พยายามทำให้สิ่งนี้ใช้งานได้กับตัวกรองคอลัมน์ แต่ดูเหมือนจะไม่ทำงาน ฉันต้องการรหัสอื่นสำหรับสิ่งนั้นหรือไม่

ขอบคุณ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีจัสติน
คุณได้รับข้อความแจ้งข้อผิดพลาดหรือไม่? ฉันต้องการทราบเฉพาะเจาะจงมากขึ้นเกี่ยวกับปัญหาของคุณ
ก่อนใช้รหัสอย่าลืมแก้ไข "ชื่อแผ่น""ชื่อของตารางเดือย""ชื่อของตัวกรองตารางเดือย" และ เซลล์ คุณต้องการกรองตารางเดือยตาม (ดู sceenshot)
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล

ขอบคุณสำหรับความช่วยเหลือของคุณ. ปัญหาคือฟังก์ชั่นไม่ได้ทำอะไรด้วยเหตุผลบางประการ คำชี้แจงบางประการ:

ชื่อ Pivot: Order_Comp_B2C
ชื่อแผ่นงาน: แผ่นคำนวณ
ชื่อตัวกรอง: หมายเลขสัปดาห์ (ฉันเปลี่ยนชื่อนี้จากชื่อ "ส่งสัปดาห์ไม่มี" ในไฟล์ข้อมูล)
เซลล์ที่จะเปลี่ยน: O26 และ O27 (ควรอยู่ในช่วง)

ใน pivot นี้ ฉันกำลังพยายามเปลี่ยนตัวกรองสำหรับคอลัมน์ ฉันไม่มีอะไรในพื้นที่ตัวกรองในเมนู PivotTable Fields

รหัสของฉันคือ:

Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
'อัพเดทโดย Extendoffice 20180702
Dim xPTable เป็น PivotTable
หรี่ xPFile เป็น PivotField
Dim xStr เป็นสตริง
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า Intersect(Target, Range("O26")) ไม่มีอะไรให้ออกจาก Sub
Application.ScreenUpdating = เท็จ
ตั้งค่า xPTable = แผ่นงาน ("แผ่นการคำนวณ") 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 ขออภัยในความไม่สะดวก.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีจัสติน ตี๋
โปรดลองใช้รหัส 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
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันใช้มันสำหรับ excell ปกติและใช้งานได้ แต่ฉันไม่สามารถใช้กับแผ่นงาน olap บางทีฉันต้องเปลี่ยนมันสักหน่อย?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี maziaritib4 TIB
วิธีการนี้ใช้ได้กับ Microsoft Excel เท่านั้น ขออภัยในความไม่สะดวก.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีจัสติน

สิ่งนี้ทำงานได้อย่างสมบูรณ์ แต่ฉันสงสัยว่ากฎนี้สามารถนำไปใช้กับ PivotTable หลายรายการภายในแผ่นงานเดียวกันได้หรือไม่

ขอบคุณ,
เจมส์
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เจมส์ hi,

ใช่ เป็นไปได้ รหัสที่ฉันใช้คือ (4 pivots และ 2 การอ้างอิงเซลล์):

Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
หรี่ฉันเป็นจำนวนเต็ม
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 เป็นสตริง
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า Intersect(Target, Range("O26:P27")) ไม่มีอะไร ก็จบ Sub

xFilterStr1 = ช่วง ("O26") .Value
xFilterStr2 = ช่วง ("O27") .Value
yFilterstr1 = ช่วง ("p26") .Value
yfilterstr2 = ช่วง ("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 = "" และ 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
End If
ต่อไป

สำหรับฉัน = 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 If
ต่อไป

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เปลี่ยนค่าใน Array(), Worksheets() และ Intersect()



** ค้นหาสิ่งเหล่านี้และเปลี่ยนแปลง **
ชื่อแผ่น
E1
PivotTable 1
PivotTable 2
PivotTable 3




Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
'อัพเดทโดย Extendoffice 20180702
Dim xPTable เป็น PivotTable
หรี่ xPFile เป็น PivotField

Dim xPTabled เป็น PivotTable
Dim xPยื่นเป็น PivotField

Dim xStr เป็นสตริง



เกี่ยวกับข้อผิดพลาดต่อไป

'รีสสท 만들기
Dim listArray() เป็น Variant
listArray = Array("PivotTable1", "PivotTable2", "PivotTable3")



ถ้า Intersect(Target, Range("E1")) ไม่มีอะไรก็ให้ออกจาก Sub
Application.ScreenUpdating = เท็จ

สำหรับ i = 0 ถึง UBound(listArray)

ตั้งค่า xPTable = แผ่นงาน ("ชื่อแผ่นงาน") PivotTables (listArray (i))
ตั้งค่า xPFile = xPTable.PivotFields("Company_ID")

xStr = เป้าหมาย ข้อความ
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



ต่อไป

Application.ScreenUpdating = จริง



ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี,

รหัสทำงานได้ดีสำหรับฉัน อย่างไรก็ตาม ฉันไม่สามารถรับตารางเดือยเพื่ออัปเดตเป้าหมายตัวกรองโดยอัตโนมัติ เป้าหมายในกรณีของฉันคือสูตร [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 มีการเปลี่ยนแปลง ตารางเดือยจะรีเซ็ตเป็นไม่มีตัวกรอง คุณช่วยฉันเรื่องนี้ได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ST,
ฉันไม่ค่อยเข้าใจที่คุณหมายถึง ในกรณีของคุณ ค่าของเซลล์เป้าหมาย D3 ใช้เพื่อกรองตารางสาระสำคัญ สูตรในเซลล์เป้าหมาย D3 อ้างอิงค่าของเซลล์ A15, B15 และ C15 ซึ่งจะเปลี่ยนแปลงตามค่าในเซลล์อ้างอิง เมื่อค่าใดๆ ใน A15, B15 และ C15 เปลี่ยนแปลง ตารางสาระสำคัญจะถูกกรองโดยอัตโนมัติหากค่าในเซลล์เป้าหมายตรงตามเงื่อนไขการกรองของตารางสาระสำคัญ ถ้าค่าในเซลล์เป้าหมายไม่ตรงตามเกณฑ์การกรองของตาราง Pivot ตาราง Pivot จะถูกรีเซ็ตโดยอัตโนมัติเป็นไม่มีการกรอง
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันไม่แน่ใจว่ามีวิธีแชร์ไฟล์ 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()

PivotTable 1
PivotTable 2
PivotTable 3
PivotTable 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   ตัวอักษร
สถานที่แนะนำ