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

วิธีการซิงโครไนซ์รายการแบบหล่นลงในหลายแผ่นงานใน Excel?

สมมติว่าคุณมีรายการดรอปดาวน์บนเวิร์กชีตหลายแผ่นในเวิร์กบุ๊กที่มีรายการดรอปดาวน์เหมือนกันทุกประการ ตอนนี้ คุณต้องการซิงโครไนซ์รายการดรอปดาวน์ในเวิร์กชีต ดังนั้นเมื่อคุณเลือกรายการจากรายการดรอปดาวน์ในเวิร์กชีตเดียว รายการดรอปดาวน์ในเวิร์กชีตอื่นๆ จะซิงโครไนซ์การเลือกเดียวกันโดยอัตโนมัติ บทความนี้มีรหัส VBA เพื่อช่วยคุณแก้ปัญหานี้

ซิงโครไนซ์รายการดรอปดาวน์ในหลายแผ่นงานด้วยรหัส VBA


ซิงโครไนซ์รายการดรอปดาวน์ในหลายแผ่นงานด้วยรหัส VBA

ตัวอย่างเช่น รายการดรอปดาวน์อยู่ในห้าเวิร์กชีตที่ชื่อว่า แผ่นที่ 1 แผ่นที่ 2 ... แผ่นที่ 5 เพื่อซิงโครไนซ์รายการดรอปดาวน์ในเวิร์กชีตอื่นตามการเลือกแบบเลื่อนลงใน Sheet1 โปรดใช้โค้ด VBA ต่อไปนี้เพื่อดำเนินการให้เสร็จสิ้น

1. เปิด Sheet1 คลิกขวาที่แท็บแผ่นงานแล้วเลือก ดูรหัส จากเมนูคลิกขวา

2 ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่างวางโค้ด VBA ต่อไปนี้ลงใน แผ่นที่ 1 (รหัส) หน้าต่าง

รหัส VBA: ซิงโครไนซ์รายการแบบหล่นลงในหลายแผ่นงาน

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220815
    Dim tSheet1 As Worksheet
    Dim tRange As Range
    Dim xRangeStr As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr = "A2:A11"

    Set tRange = Intersect(Target, Range(xRangeStr))
    If Not tRange Is Nothing Then
        xRangeStr = tRange.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet2")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet3")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet4")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet5")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Application.EnableEvents = True
    End If
    
End Sub

หมายเหตุ:

1) ในรหัส A2: A11 คือช่วงที่มีรายการดรอปดาวน์ ตรวจสอบให้แน่ใจว่ารายการดรอปดาวน์ทั้งหมดอยู่ในช่วงเดียวกันในเวิร์กชีตต่างๆ
2) แผ่นที่ 2 แผ่นที่ 3 แผ่นที่ 4 และ Sheet5 เป็นเวิร์กชีตที่มีรายการดรอปดาวน์ที่คุณต้องการซิงโครไนซ์ตามรายการดรอปดาวน์ใน Sheet1
3) หากต้องการเพิ่มเวิร์กชีตในโค้ดเพิ่มเติม โปรดเพิ่มสองบรรทัดต่อไปนี้ก่อนบรรทัด "Application.EnableEvents = จริง” จากนั้นเปลี่ยนชื่อแผ่นงาน “Sheet5” ให้กับชื่อที่คุณต้องการ
ตั้งค่า tSheet1 = ActiveWorkbook.Worksheets("Sheet5")
tSheet1.Range(xRangeStr).Value = Target.Value

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

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


การสาธิต: ซิงโครไนซ์รายการดรอปดาวน์ในหลายแผ่นงานใน Excel


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

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
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (5)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี

ฉันจะทำสิ่งนี้ได้อย่างไรหากรายการแบบเลื่อนลงของฉันอยู่ในช่วงที่แตกต่างกัน ในการอธิบายอย่างละเอียด ฉันมีรายการดรอปดาวน์ในแผ่นงาน 7 ที่อยู่ในเซลล์ B7 และรายการแบบเลื่อนลงแบบเดียวกันบนแผ่นที่ 6 ในเซลล์ B2

ขอขอบคุณ,
เอเลน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีอี
รหัส VBA ต่อไปนี้สามารถช่วยได้
ที่นี่ฉันใช้ Sheet6 เป็นเวิร์กชีตหลัก คลิกขวาที่แท็บชีต เลือก ดูโค้ดจากเมนูคลิกขวา จากนั้นคัดลอกโค้ดต่อไปนี้ในหน้าต่าง Sheet6 (โค้ด) เมื่อคุณเลือกรายการใดๆ จากรายการดรอปดาวน์ใน B2 ของ Sheet6 รายการดรอปดาวน์ใน B7 ของ Sheet7 จะถูกซิงโครไนซ์เพื่อให้มีรายการที่เลือกเหมือนกัน

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221025
    Dim tSheet1 As Worksheet
    Dim tRange As Range
    Dim xRangeStr As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr = "B2"
    
    Set tRange = Range("B7")
    If Not tRange Is Nothing Then
        xRangeStr = tRange.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr).Value = Target.Value
        Application.EnableEvents = True
    End If
    
End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล

ขอบคุณมากสำหรับคำตอบของคุณ รหัสของคุณใช้งานได้! ฉันมีเซลล์ใต้ b2 และ b7, b3 และ b8 ตามลำดับซึ่งจำเป็นต้องมีฟังก์ชันเดียวกัน ฉันพยายามเขียนโค้ดของคุณใหม่ดังที่แสดงด้านล่าง แต่ไม่ได้ผล มันทำให้ b7 แทนที่จะเป็น b8 เปลี่ยนไปเมื่อฉันเปลี่ยน b3 คุณอาจจะสามารถระบุสิ่งที่ฉันทำผิด?

ขอบคุณมาก!

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221025
    Dim tSheet1 As Worksheet
    Dim tRange1 As Range
    Dime tRange2 As Range
    Dim xRangeStr1 As String
    Dim xRangeStr2 As String
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    
    xRangeStr1 = "B2"
    xRangeStr2="B3"
    
    Set tRange1 = Range("B7")
    If Not tRange1 Is Nothing Then
        xRangeStr1 = tRange1.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr1).Value = Target.Value
        Application.EnableEvents = True
    End If
    
    Set tRange2 = Range("B8")
    If Not tRange2 Is Nothing Then
        xRangeStr2 = tRange2.Address
        Application.EnableEvents = False
        Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
        tSheet1.Range(xRangeStr2).Value = Target.Value
        Application.EnableEvents = True
    End If

End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีอี
มีบางอย่างผิดปกติกับรหัส VBA ที่ฉันตอบคุณข้างต้น
สำหรับคำถามใหม่ที่คุณกล่าวถึง โปรดลองใช้รหัสต่อไปนี้

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20221031
    
    Dim xBool1 As Boolean
    Dim xBool2 As Boolean
    Dim xRgStr As String
    Dim tRange As Range
    
    xRangeStr1 = "B2"
    xRangeStr2 = "B3"
    xRgStr = ""
    
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    xBool1 = Intersect(Target, Range(xRangeStr1)) Is Nothing
    xBool2 = Intersect(Target, Range(xRangeStr2)) Is Nothing
    
    If xBool1 And xBool2 Then Exit Sub
    
    xRgStr = Target.Address(False, False, xlA1, False, False)
    
    If Target.Address(False, False, xlA1, False, False) = xRangeStr1 Then
        xRgStr = "b7"
    ElseIf Target.Address(False, False, xlA1, False, False) = xRangeStr2 Then
        xRgStr = "b8"
    End If
    If xRgStr = "" Then Exit Sub
    
    Application.EnableEvents = False
    Set tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
    tSheet1.Range(xRgStr).Value = Target.Value
    Application.EnableEvents = True

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

ขอบคุณมากสำหรับคำตอบของคุณ มันได้ผล! ฉันจะแก้ไขโค้ดเพื่อเพิ่มเซลล์อื่นในชีต 6, B3 เดียวกันที่จำเป็นต้องซิงโครไนซ์กับ B8 ในชีต 7 ได้อย่างไร ฉันพยายามแก้ไขด้านล่าง แต่ลงเอยด้วยการวางเนื้อหาของ B3 บนแผ่นที่ 6 ใน B7 บนแผ่นงาน 7 แทนที่จะเป็น B8


Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
'ปรับปรุงโดย Extendoffice 20221025
Dim tSheet1 เป็นแผ่นงาน
Dim tRange1 เป็นช่วง
Dim tRange2 เป็นช่วง
Dim xRangeStr1 เป็นสตริง
Dim xRangeStr2 เป็นสตริง
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า Target.Count > 1 แล้วออกจาก Sub

xRangeStr1 = "B2"
xRangeStr2 = "B3"

ตั้งค่า tRange1 = ช่วง ("B7")
ถ้าไม่ใช่ tRange1 ก็ไม่มีอะไรทั้งนั้น
xRangeStr1 = tRange1.Address
Application.EnableEvents = เท็จ
ตั้งค่า tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr1).Value = Target.Value
Application.EnableEvents = จริง
End If

ตั้งค่า tRange2 = ช่วง ("B8")
ถ้าไม่ใช่ tRange2 ก็ไม่มีอะไรทั้งนั้น
xRangeStr2 = tRange2.Address
Application.EnableEvents = เท็จ
ตั้งค่า tSheet1 = ActiveWorkbook.Worksheets("Sheet7")
tSheet1.Range(xRangeStr2).Value = Target.Value
Application.EnableEvents = จริง
End If

ย่อยสิ้นสุด
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ