Я работаю над настройкой VBA для расширенного файла отслеживания ошибок. У меня есть один лист, который содержит все вопросы и которыми трудно управлять. У меня есть еще один лист, который предназначен для того, чтобы предоставить пользователю 10 элементов с наивысшим приоритетом на определенный день, разрешить им обновить эти элементы и затем устранить другие проблемы. Из-за способа зеркального отображения данных мне нужно, чтобы пользователи могли манипулировать данными на одном листе и отображать их на другом листе.

Из другого вопроса я нашел предложенный код, и я смог заставить его работать, пока у меня есть только одна зеркальная ячейка, но как только я начинаю дублировать код для добавления в другие ячейки (необходимо около 200 ячеек). зеркальное отображение), все ячейки перестают обновляться (включая ту, которая ранее работала).

Другая проблема, с которой я столкнулся еще до того, как я добавил дополнительные строки кода зеркального отображения ячеек, связана с тем, как лист сообщает о десяти элементах с наивысшим приоритетом. Я создал макрос, который берет первый лист (трудный для понимания) и сортирует данные определенным образом, и я прикрепил этот макрос к кнопке на другой странице. Когда я нажимаю кнопку, она правильно сортирует данные на первом листе, но ячейка, которая была отражена, никогда не обновляется. Поэтому мне нужно знать 1) Как настроить мой код так, чтобы отражать несколько ячеек, и 2) Как сделать так, чтобы при сортировке первого листа с помощью кнопки данные обновлялись на втором листе.

Код, который работал, когда у меня был только один набор зеркальных ячеек, был расположен в коде Листа 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

Любая помощь по обоим этим вопросам с благодарностью!

заранее спасибо

|источник

0