故障排除 - 如何使用 VBA 在 Excel (2013) 中镜像不同工作表中的两个单元格

故障排除 - 如何使用 VBA 在 Excel (2013) 中镜像不同工作表中的两个单元格

我正在为一个广泛的问题跟踪文件设置 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

在 Sheet 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

非常感谢您对这两个问题提供的任何帮助!!!

提前致谢

相关内容