☰

Excel 2010：根据数据源验证工作表的变化动态更新下拉列表

tag-icon • tag-icon microsoft-excel-2010 vba macros events
Excel 2010：根据数据源验证工作表的变化动态更新下拉列表

我有一张工作表用于设置多个数据验证列表的数据源。换句话说，我使用此工作表为多个其他工作表提供下拉列表。

我需要根据数据源工作表上的一个或多个更改动态更新所有工作表。我可能明白这应该与整个工作簿上的事件宏一起出现。

我的问题是如何实现在整个工作簿中保持“OFFSET”公式？

谢谢

为了支持我的问题，我放上了一段试图让它工作的代码：

提供以下信息：

  • 我正在使用这样一个公式对下拉列表进行伪动态更新，例如：

=OFFSET(MyDataSourceSheet!$O$2;0;0;COUNTA(MyDataSourceSheet!O:O)-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

答案1

基于以下设置，我现在可以工作了：

一个数据源工作表，工作表更改事件设置如下。此宏调用目标工作表宏更新下拉列表带有 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

相关内容