VBA中单独工作表中的动态依赖列表（2）

Question

我正在使用7个动态依赖列表，我认为如果我修改列表是自动化过程并避免在将来安排任何事情的最佳方法是VBA代码。

我开始处理的VBA代码发布在：Dynamic Depending Lists in Separated WorkSheets in VBA

该代码仅适用于2个第一个列表。

这是我的主要表格。我想只为黄色列的第一行选择列表：

这是我有列表的表（它们必须是动态的）：

我的名单之间的关系是：

• 负责人名单和网站列表与项目列表相关。
• 其他列表与网站列表相关。

Answer 1

好。我有你想要的东西。几个月前我在另一个项目中解决了这个问题。基本上，间接在这里并不好，因为它不适用于动态命名范围，因为它们不会产生实际结果，只会产生公式引用。

首先，在表格上设置您的命名范围。以我描述的方式命名命名范围非常重要，因为这将为编写动态列表提供代码。另外，请注意，我只为X1和T2写了SamplePoints。如果选择其他选项，则在您添加这些命名范围之前，代码将不起作用。

然后假设输入表设置如下：

将此代码放在输入表的工作表更改事件中。它的作用是获取在一个单元格中选择的值，然后附加相应的列名称以提供该列表。因此，如果选择了项目A并且您想为项目A选择一个负责方，它会将范围（“B（您所在的行）”中的验证设置为A_Responsible，从而为您提供该列表。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim wks As Worksheet
Dim strName As String, strFormula
Dim rng As Range

Set wks = ActiveSheet

With wks

    If Target.Row = 1 Then Exit Sub

    Select Case Target.Column

        Case Is = .Rows(1).Find("Project", lookat:=xlWhole).Column

            Set rng = Target.Offset(, 1)

            strName = Target.Value
            strFormula = "=" & Replace(strName, " ", "_") & "_Responsible"

            AddValidation rng, 1, strFormula

            'add any more cells that would need validation based on project selection here.

        Case Is = .Rows(1).Find("Responsible", lookat:=xlWhole).Column

            Set rng = Target.Offset(, 1)

            strName = Target.Value
            strFormula = "=" & Replace(strName, " ", "_") & "_SamplePoint"

            AddValidation rng, 1, strFormula

            'add any more cells that would need validation based on responsible selection here.

        'Case Is = add any more dependenices here ... and continue with cases for each one

    End Select

End With

您还需要在工作簿中的某个标准模块中使用此功能。

Function AddValidation(ByVal rng As Range, ByVal iOperator As Integer, _
    ByVal sFormula1 As String, Optional iXlDVType As Integer = 3, _
    Optional iAlertStyle As Integer = 1, Optional sFormula2 As String, _
    Optional bIgnoreBlank As Boolean = True, Optional bInCellDropDown As Boolean = True, _
    Optional sInputTitle As String, Optional sErrorTitle As String, _
    Optional sInputMessage As String, Optional sErrorMessage As String, _
    Optional bShowInput As Boolean = True, Optional bShowError As Boolean = True)

'==============================================
'Enumaration for ease of use
'XlDVType
'Name Value Description
'xlValidateCustom 7 Data is validated using an arbitrary formula.
'xlValidateDate 4 Date values.
'xlValidateDecimal 2 Numeric values.
'xlValidateInputOnly 0 Validate only when user changes the value.
'xlValidateList 3 Value must be present in a specified list.
'xlValidateTextLength 6 Length of text.
'xlValidateTime 5 Time values.
'xlValidateWholeNumber 1 Whole numeric values.

'AlertStyle
'xlValidAlertInformation 3 Information icon.
'xlValidAlertStop 1 Stop icon.
'xlValidAlertWarning 2 Warning icon.

'Operator
'xlBetween 1 Between. Can be used only if two formulas are provided.
'xlEqual 3 Equal.
'xlGreater 5 Greater than.
'xlGreaterEqual 7 Greater than or equal to.
'xlLess 6 Less than.
'xlLessEqual 8 Less than or equal to.
'xlNotBetween 2 Not between. Can be used only if two formulas are provided.
'xlNotEqual 4 Not equal.
'==============================================

With rng.Validation
    .Delete ' delete any existing validation before adding new one
    .Add Type:=iXlDVType, AlertStyle:=iAlertStyle, Operator:=iOperator, Formula1:=sFormula1, Formula2:=sFormula2
    .IgnoreBlank = bIgnoreBlank
    .InCellDropdown = bInCellDropDown
    .InputTitle = sInputTitle
    .ErrorTitle = sErrorTitle
    .InputMessage = sInputMessage
    .ErrorMessage = sErrorMessage
    .ShowInput = bShowInput
    .ShowError = bShowError
End With


End Function