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