疑难解答 - 如何使用VBA在Excel(2013)中镜像来自不同工作表的两个单元格


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 2017年
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.