Excel VBA附加驗證列表

Question

我有一個列表驗證，我在Excel VBA中創建，它基於一組範圍內的一組數據。然後我想用第二範圍數據中的一組數據添加到列表中。我認爲修改功能可能會起作用，但我在列表中收到的是第一個範圍內的數據。

我在工作表上有一個列表，我指的是構成範圍。該範圍有一個WCGroupName列和一個包含唯一數據的列。

例如左側的列是基團上，經分離的右列 - 是列表：

GROUP - LIST

擠出機 - 10- EXTRUDER
擠出機 - - 15 80 EXTRUDER
MOUNT - 20-MOUNTER
PRESS - 30-PRESS BONARDI
底側 - 42-BOTTOMSEAL
底側 - 72-SIDEWELD BOTTOMPUNCH - 73- SIDEWELD2
BOTTOMSEAL - 40 BOTTOMSEAL
便門 - 60便門
便門 - 62便門

我想驗證列表顯示在列表中的4項。下面只代碼示出了第一2.我基本上試圖附加列表，以便它顯示

42 BOTTOMSEAL，72-SIDEWELD，73-SIDEWELD2，40 BOTTOMSEAL

在下拉列表中。此代碼位於另一個循環中，該循環遍歷所有WCGROUPNAME並創建多個驗證列表。但是，我需要在工作表br上爲單元格B23分配的驗證列表添加，然後添加。

讓我知道這是否可能。

我已修改我的代碼插入以顯示我正在做的更廣泛的範圍。 GetUniqueWCGroup是一個創建管道列表的函數。

'This section will create the list lookups for each WC type 
WCGroup = GetUniqueWCGroup() 
WCGroupArray = Split(WCGroup, "|") 

'Create a report for each team 
For Each tmp In WCGroupArray 

    WCGroupName = CStr(tmp) 
    wg = WCGroupName 
    'identify last row for the group 
    wc.Activate 
    frwg = lrwg + 1 
    lrwg = xlLastRowWCGroup(wg) 

    If WCGroupName = "MOUNT" Then 

     Set l = br.Range("B21:B21") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 

    End If 'WCGroup Mounter 

    If WCGroupName = "PRESS" Then 

     Set l = br.Range("B22:B22") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 
    End If 'WCGroup Press 

    If WCGroupName = "BOTTOMSEAL" Or WCGroupName = "BOTTOMSIDE" Then 

     If bc = 1 Then 

      Set l = br.Range("B23:B23") 
      Set R = wc.Range("B" & frwg & ":B" & lrwg) 

      With l.Validation 
       .Delete 'delete previous validation 
       .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
        Formula1:="='" & wc.Name & "'!" & R.Address 
      End With 

      bc = bc + 1 
     Else 

      Set l = br.Range("B23:B23") 
      Set R = wc.Range("B" & frwg & ":B" & lrwg) 

      With l.Validation 
       '.Delete 'delete previous validation 
       .Modify Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
        Operator:=xlBetween, Formula1:="='" & wc.Name & "'!" & R.Address 
      End With 

     End If 


    End If 'WCGroup BottomSeal or BottomSide 

    If WCGroupName = "WICKET" Then 

     Set l = br.Range("B24:B24") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 
    End If 'WCGroup Wicket 

    If WCGroupName = "BOTTOMSIDE" Then 

     Set l = br.Range("B25:B25") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 
    End If 'WCGroup BottomSide 

    If WCGroupName = "SLITTER" Then 

     Set l = br.Range("B26:B26") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 
    End If 'WCGroup Slitting 

    If WCGroupName = "PERFORATOR" Then 

     Set l = br.Range("B27:B27") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 

    End If 'Perforator 

    If WCGroupName = "OP" Then 

     Set l = br.Range("B29:B29") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 

     Set l = br.Range("B30:B30") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 

     Set l = br.Range("B31:B31") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 

     Set l = br.Range("B32:B32") 
     Set R = wc.Range("B" & frwg & ":B" & lrwg) 

     With l.Validation 
      .Delete 'delete previous validation 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ 
       Formula1:="='" & wc.Name & "'!" & R.Address 
     End With 

    End If 'OP 

Next 

Answer 1

正如你可能知道，有方法來創建DV列表：

1. 工作表單元格
2. 逗號分隔字符串（CSS）

的第二種方法是：

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
     xlBetween, Formula1:="larry,moe,curley" 

這意味着，如果有兩個或多個不相交的範圍，你可以通過一個單一的CSS

在這個例子中創建一個DV列表中，我們結合了A1的內容：A5和A8：A10放入單個DV：

Sub DisJointDatJoint() 
    Dim rDV As Range, sDV As String 
    Set rDV = Range("A1:A5,A8:A10") 
    sDV = "" 
    For Each r In rDV 
     sDV = sDV & r.Value & "," 
    Next r 
    sDV = Mid(sDV, 1, Len(sDV) - 1) 
    With Selection.Validation 
      .Delete 
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ 
      xlBetween, Formula1:=sDV 
      .IgnoreBlank = True 
      .InCellDropdown = True 
      .InputTitle = "" 
      .ErrorTitle = "" 
      .InputMessage = "" 
      .ErrorMessage = "" 
      .ShowInput = True 
      .ShowError = True 
    End With 
End Sub