Excel 2010:データソース検証ワークシートの変更に基づいたドロップダウンリストの動的更新


0

複数のデータ検証リストのデータソースを設定するためのワークシートが1つあります。つまり、このワークシートを使用して、他の複数のワークシートにドロップダウンリストを提供しています。

データソースワークシートの1つまたは複数の変更のいずれかで、すべてのワークシートを動的に更新する必要があります。これは、ブック全体のイベントマクロを使用する必要があることを理解できます。

私の質問は、これをどのようにしてブック全体で「オフセット」式を維持するのですか?

どうも


私の質問をサポートするために、私はそれを機能させようとしているコードを入れました:

以下の情報を提供しました:

  • 私はドロップダウンリストの擬似動的更新のためにそのような式を使用しています、例えば:

= 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

回答:


0

次のセットアップに基づいて、今すぐ動作しました:

次のマクロに従って、ワークシート変更イベントのセットアップを含む1つのデータソースワークシート。このマクロは、ドロップダウンリストの動的更新に必要な2つの引数(古い値と新しい値)を使用して、宛先ワークシートマクロUpdateDropDownListを呼び出します。

データソースワークシートマクロ(変更イベント):

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
弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.