Excel 2010: динамическое обновление раскрывающегося списка на основе изменений листа проверки источника данных

Question

У меня есть один рабочий лист для настройки источников данных нескольких списков проверки данных. другими словами, я использую этот лист для предоставления раскрывающихся списков нескольким другим листам.

Мне нужно динамически обновлять все листы при любом одном или нескольких изменениях в листе источника данных. Я могу понять, что это должно прийти с макросом события по всей книге.

Мой вопрос заключается в том, как добиться этого, сохраняя формулу "СМЕЩЕНИЕ" по всей книге?

Спасибо

---

Чтобы поддержать мой вопрос, я поместил фрагмент кода, который пытаюсь заставить его работать:

Предоставлена следующая информация:

• Я использую такую формулу для псевдодинамического обновления выпадающих списков, например:

= OFFSET(MyDataSourceSheet!$ O $ 2; 0; 0; COUNTA(MyDataSourceSheet!О: О)-1)

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

Макрос, связанный с таблицей источника данных:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' Macro to update all worksheets with drop down list referenced upon
' this data source worksheet, base on ref names

    Dim cell As Range
    Dim isect As Range
    Dim vOldValue As Variant, vNewValue As Variant

    Dim dvLists(1 To 6) As String 'data validation area
    Dim OneValidationListName As Variant

    dvLists(1) = "mylist1"
    dvLists(2) = "mylist2"
    dvLists(3) = "mylist3"
    dvLists(4) = "mylist4"
    dvLists(5) = "mylist5"
    dvLists(6) = "mylist6"

    On Error GoTo errorHandler

    For Each OneValidationListName In dvLists

        'Set isect = Application.Intersect(Target, ThisWorkbook.Names("STEP").RefersToRange)
        Set isect = Application.Intersect(Target, ThisWorkbook.Names(OneValidationListName).RefersToRange)

        ' If a change occured in the source data sheet
        If Not isect Is Nothing Then

            ' Prevent infinite loops
            Application.EnableEvents = False

            ' Get previous value of this cell
            With Target
                vNewValue = .Value
                Application.Undo
                vOldValue = .Value
                .Value = vNewValue
            End With

            ' LOCAL dropdown lists : For every cell with validation
            For Each cell In Me.UsedRange.SpecialCells(xlCellTypeAllValidation)
                With cell
                    ' If it has list validation AND the validation formula matches AND the value is the old value
                    If .Validation.Type = 3 And .Validation.Formula1 = "=" & OneValidationListName And .Value = vOldValue Then

                        ' Debug
                        ' MsgBox "Address: " & Target.Address

                        ' Change the cell value
                         cell.Value = vNewValue



                    End If
                End With
            Next cell

            ' Call to other worksheets update macros
             Call Sheets(5).UpdateDropDownList(vOldValue, vNewValue)

            ' GoTo NowGetOut
            Application.EnableEvents = True

        End If
     Next OneValidationListName


NowGetOut:
    Application.EnableEvents = True
    Exit Sub

errorHandler:
    MsgBox "Err " & Err.Number & " : " & Err.Description
    Resume NowGetOut


End Sub

Макрос UpdateDropDownList, связанный с рабочим листом назначения:

Sub UpdateDropDownList(Optional vOldValue As Variant, Optional vNewValue As Variant)

        ' Debug
        MsgBox "Received info for update : " & vNewValue

        ' For every cell with validation
        For Each cell In Me.UsedRange.SpecialCells(xlCellTypeAllValidation)
            With cell
                ' If it has list validation AND the validation formula matches AND the value is the old value
                ' If .Validation.Type = 3 And .Value = vOldValue Then
                If .Validation.Type = 3 And .Value = vOldValue Then
                    ' Change the cell value
                    cell.Value = vNewValue
                End If
            End With
        Next cell

End Sub

Answer 1

Я получил его сейчас, основываясь на следующей настройке:

Один рабочий лист источника данных с настройкой события изменения рабочего листа согласно макросу ниже. Этот макрос вызывает целевой макрос макросов UpdateDropDownList с 2 аргументами (старое и новое значение), которые необходимы для динамического обновления выпадающих списков.

Макрос рабочей таблицы источника данных (событие изменения):

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' Macro to update all worksheets with drop down list referenced upon
' this data source worksheet, base on ref names

    Dim cell As Range
    Dim isect As Range
    Dim vOldValue As Variant, vNewValue As Variant

    Dim dvLists(1 To 6) As String 'data validation area
    Dim OneValidationListName As Variant

    dvLists(1) = "myListName1"
    dvLists(2) = "myListName2"
    dvLists(3) = "myListName3"
    dvLists(4) = "myListName4"
    dvLists(5) = "myListName5"
    dvLists(6) = "myListName6"

    On Error GoTo errorHandler

    For Each OneValidationListName In dvLists

        Set isect = Application.Intersect(Target, ThisWorkbook.Names(OneValidationListName).RefersToRange)

        ' If a change occured in the datasource worksheet
        If Not isect Is Nothing Then

            ' Prevent infinite loops
            Application.EnableEvents = False

            ' Get previous value of this cell
            With Target
                vNewValue = .Value
                Application.Undo
                vOldValue = .Value
                .Value = vNewValue
            End With

             ' Call to other worksheets update macros
             Call Sheets(5).UpdateDropDownList(vOldValue, vNewValue)

            ' GoTo NowGetOut
            Application.EnableEvents = True

        End If
    Next OneValidationListName


NowGetOut:
    Application.EnableEvents = True
    Exit Sub

errorHandler:
    MsgBox "Format Err " & Err.Number & " : " & Err.Description
    Resume NowGetOut


End Sub

Макрос листа назначения:

Sub UpdateDropDownList(Optional vOldValue As Variant, Optional vNewValue As Variant)

On Error GoTo errorHandler

        ' Debug
        ' MsgBox "Received info for update : " & vNewValue

        ' For every cell with validation
        For Each cell In Me.UsedRange.SpecialCells(xlCellTypeAllValidation)
            With cell
                ' If it has list validation AND the validation formula matches AND the value is the old value
                If .Validation.Type = 3 And .Value = vOldValue Then
                    ' Change the cell value
                    cell.Value = vNewValue
                End If
            End With
        Next cell

Exit Sub

errorHandler:
    MsgBox "Saisie Err : " & Err.Number & " : " & Err.Description
End Sub