動態依賴VBA中分離工作表中的列表（012）

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