การแก้ไขปัญหา - วิธีการทำมิรเรอร์สองเซลล์จากแผ่นงานที่แตกต่างกันใน Excel (2013) โดยใช้ VBA


0

ฉันกำลังทำงานกับการตั้งค่า VBA สำหรับไฟล์การติดตามปัญหาที่กว้างขวาง ฉันมีแผ่นงานหนึ่งแผ่นที่มีปัญหาทั้งหมดและจัดการได้ยาก ฉันมีแผ่นงานอีกแผ่นที่ออกแบบมาเพื่อนำเสนอผู้ใช้ด้วย 10 ลำดับความสำคัญสูงสุดสำหรับวันที่กำหนดอนุญาตให้พวกเขาอัปเดตรายการเหล่านั้นแล้วดึงข้อมูลปัญหาเพิ่มเติม เนื่องจากวิธีการที่ข้อมูลถูกมิเรอร์ฉันต้องการให้ผู้ใช้สามารถจัดการข้อมูลในชีตทั้งสองและให้มิร์เรอร์กับชีตอื่น

ฉันพบจากคำถามอื่นบางข้อเสนอแนะและฉันสามารถทำให้มันทำงานตราบใดที่ฉันมีเพียงหนึ่งเซลล์มิเรอร์ แต่ทันทีที่ฉันเริ่มทำซ้ำรหัสเพื่อเพิ่มในเซลล์อื่น ๆ (มีประมาณ 200 เซลล์ที่จำเป็นต้องเป็น มิร์เรอร์) เซลล์ทั้งหมดหยุดการอัปเดต (รวมถึงเซลล์ที่ทำงานก่อนหน้านี้)

ปัญหาอื่น ๆ ที่ฉันได้เห็นแม้กระทั่งก่อนที่ฉันจะเพิ่มเซลล์พิเศษที่มิเรอร์สายรหัสที่เกี่ยวข้องกับวิธีการที่แผ่นรายงานสิบรายการลำดับความสำคัญสูงสุด ฉันสร้างมาโครที่ใช้ชีตแรก (ยากที่จะเข้าใจ) และเรียงลำดับข้อมูลในลักษณะเฉพาะและฉันได้แนบมาโครนั้นกับปุ่มบนหน้าอื่น ๆ เมื่อฉันกดปุ่มมันจะเรียงลำดับข้อมูลในชีตแรกอย่างถูกต้อง แต่เซลล์ที่ถูกมิเรอร์ไม่เคยอัปเดต ดังนั้นฉันจำเป็นต้องรู้1)วิธีปรับรหัสของฉันเพื่อให้สามารถสะท้อนหลายเซลล์และ2)ทำอย่างไรเมื่อฉันเรียงลำดับแผ่นงานแรกโดยใช้ปุ่มการปรับปรุงข้อมูลในแผ่นงานที่สอง

รหัสที่ใช้งานได้เมื่อฉันมีเซลล์มิเรอร์หนึ่งชุดเท่านั้นคือรหัสต่อไปนี้ที่อยู่ในรหัส Sheet 1:

Private Sub Worksheet_Change_B2(ByVal Target As Range)

    Dim B2 As Range, B2_1 As Range
    Set B2 = Range("B2")
    Set B2_1 = Sheets("Priority Table").Range("B2")
    If Intersect(Target, B2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B2_1.Value = B2.Value
    Application.EnableEvents = True

End Sub

และรหัสต่อไปนี้อยู่ในแผ่นงาน 2:

Private Sub Worksheet_Change_B2(ByVal Target As Range)

    Dim B2 As Range, B2_1 As Range
    Set B2 = Range("B2")
    Set B2_1 = Sheets("Issue List").Range("B2")
    If Intersect(Target, B2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B2_1.Value = B2.Value
    Application.EnableEvents = True

End Sub

สิ่งที่ฉันมีในแผ่นงานที่ 1 ในปัจจุบันคือ (ฉันรวมเซลล์อ้างอิงสามเซลล์แทนที่จะเป็น 200 + ทั้งหมด)

Private Sub Worksheet_Change_B2(ByVal Target As Range)

    Dim B2 As Range, B2_1 As Range
    Set B2 = Range("B2")
    Set B2_1 = Sheets("Priority Table").Range("B2")
    If Intersect(Target, B2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B2_1.Value = B2.Value
    Application.EnableEvents = True

End Sub    

Private Sub Worksheet_Change_I2(ByVal Target As Range)

    Dim I2 As Range, I2_1 As Range
    Set I2 = Range("I2")
    Set I2_1 = Sheets("Priority Table").Range("B3")
    If Intersect(Target, I2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        I2_1.Value = I2.Value
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change_P2_1(ByVal Target As Range)

    Dim P2 As Range, P2_1 As Range
    Set P2 = Range("P2")
    Set P2_1 = Sheets("Priority Table").Range("B4")
    If Intersect(Target, P2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        P2_1.Value = P2.Value
    Application.EnableEvents = True

End Sub

และในแผ่นที่ 2 รหัสที่ตรงกันคือ:

Private Sub Worksheet_Change_B2(ByVal Target As Range)

    Dim B2 As Range, B2_1 As Range
    Set B2 = Range("B2")
    Set B2_1 = Sheets("Issue List").Range("B2")
    If Intersect(Target, B2) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B2_1.Value = B2.Value
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change_B3(ByVal Target As Range)

    Dim B3 As Range, B3_1 As Range
    Set B3 = Range("B3")
    Set B3_1 = Sheets("Issue List").Range("I2")
    If Intersect(Target, B3) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B3_1.Value = B3.Value
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_Change_B4(ByVal Target As Range)

    Dim B4 As Range, B4_1 As Range
    Set B4 = Range("B4")
    Set B4_1 = Sheets("Issue List").Range("P2")
    If Intersect(Target, B4) Is Nothing Then Exit Sub
    Application.EnableEvents = False
        B4_1.Value = B4.Value
    Application.EnableEvents = True

End Sub

ความช่วยเหลือสำหรับปัญหาทั้งสองนี้ได้รับการชื่นชมอย่างมาก !!!

ขอบคุณล่วงหน้า


อย่าExit Subเมื่อเช็คของคุณล้มเหลว นี่เป็นสาเหตุที่ทำให้รหัสของคุณเกือบทั้งหมดถูกตัดผ่าน ตรวจสอบIf Not (Intersect(Target, "B2") Is Nothing) Then ด้วยความเหมาะสมEnd Ifแทน
OldUgly

มันทำงานได้อย่างสมบูรณ์แบบ มันจบลงด้วยการเป็นมาโครที่มีขนาดใหญ่เกินไปดังนั้นฉันจึงแบ่งมันเป็นแมโครขนาดเล็ก 10 ตัวเพื่อจัดการทุกอย่าง แต่การเปลี่ยนแปลงนั้นเป็นสิ่งที่ฉันต้องการ
Mythranor
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.