如何从动态来源添加数据有效性序列？

OALD

代码的一部分如下，如果用固定的引用添加数据有效性序列可以成功：

                With .Cells(i, 4).Validation
                    .Delete
                    .Add Type:=xlValidateList, Formula1:="=$D$20:$F$20"
                End With


但是因为需要根据 i 的值对序列实现动态的单元格区域引用，但是如下两种方式执行都报Run-time error '1004' Application-defined or object-defined error的错误，请问各位老师怎么解决呢？非常感谢！

                With .Cells(i, 4).Validation
                    .Delete
                    .Add Type:=xlValidateList, Formula1:="=.Cells(i, 27).Resize(1, n2)"
                End With


                With .Cells(i, 4).Validation
                    .Delete
                    .Add Type:=xlValidateList, Formula1:=.Cells(i, 27).Resize(1, n2)
                End With

OALD

谢谢版主，附件已经上传。

要实现的功能是根据“Documents”工作表C列的编号，查看“FoldersGet”工作表的E列的编号，遇到一致的，把对应的G列的内容（同一个“Documents”工作表C列的编号会在“FoldersGet”工作表E列出现多次），做成下拉菜单，填到“Documents”工作表D列

lsdongjh

1. Sub Test()
   
2.     Dim shFolder As Worksheet, shDoc As Worksheet, objList As Object
   
3.     Dim arr As Variant
   
4.     Dim lngRow As Long
   
5.     Dim strID As String, strList As String
   
6.    
   
7.     Set shFolder = Sheets("FoldersGet")
   
8.     Set shDoc = Sheets("Documents")
   
9.    
   
10.     arr = shFolder.UsedRange
    
11.     Set objList = CreateObject("Scripting.Dictionary")
    
12.    
    
13.     For lngRow = 2 To UBound(arr)
    
14.         strID = Trim(arr(lngRow, 5))
    
15.         strList = arr(lngRow, 7)
    
16.         strList = Replace(strList, ",", "，") '将原有的逗号替换为中文逗号
    
17.         objList(strID) = objList(strID) & strList & ","
    
18.     Next
    
19.    
    
20.     lngRow = shDoc.Range("C" & Rows.Count).End(xlUp).Row
    
21.     arr = shDoc.Range("C1:C" & lngRow)
    
22.    
    
23.     For lngRow = 2 To UBound(arr)
    
24.         strID = Trim(arr(lngRow, 1))
    
25.         If strID <> "" Then strList = objList(strID)
    
26.         With shDoc.Cells(lngRow, 4).Validation
    
27.             .Delete
    
28.             .Add Type:=xlValidateList, Formula1:=strList
    
29.         End With
    
30.     Next
    
31.    
    
32. End Sub

复制代码

OALD

lsdongjh 发表于 2018-8-31 08:55

谢谢lsdongjh老师的解答！试了您的代码是可以的，但是原有的逗号不能替换成中文的，因此我想先把匹配到的值写到工作表AA列以后的位置，然后用“数据有效性——序列——来源”的方式来达成目的，因为在VBA里实现数据有效性貌似只能引用绝对地址，所以才有一楼的问题，请问有什么好的解决方法吗？非常感谢！

OALD

朱荣兴 发表于 2018-8-30 23:38
上传附件看看，把动态区域赋值给数组，然后用数组来建立下拉选项

谢谢版主，附件已经上传（在3楼）。

要实现的功能是根据“Documents”工作表C列的编号，查看“FoldersGet”工作表的E列的编号，遇到一致的，把对应的G列的内容（同一个“Documents”工作表C列的编号会在“FoldersGet”工作表E列出现多次），做成下拉菜单，填到“Documents”工作表D列。另外，匹配到的“FoldersGet”工作表的G列的值有的自带逗号，所以把动态区域赋值给数组貌似不行。谢谢斑竹的帮助！

lsdongjh

如果真心不想去掉逗号，最简单的办法 是将校验值输入 某个区域，然后指定单元格的检验区域。

这个操作相当于 排序某列，部分选取后，做为检验值

lsdongjh

lsdongjh

1. Sub Test()
   
2.     Dim strShName As String
   
3.     Dim shFolder As Worksheet, shDoc As Worksheet, objList As Object
   
4.     Dim arr As Variant
   
5.     Dim lngRow As Long
   
6.     Dim strID As String, strList As String, strSplit() As String
   
7.     Dim arrKeys As Variant, arrItems As Variant
   
8.     Dim Rg As Range
   
9.    
   
10.     strShName = "FoldersGet"
    
11.     Set shFolder = Sheets(strShName)
    
12.     Set shDoc = Sheets("Documents")
    
13.    
    
14.     arr = shFolder.UsedRange
    
15.     Set objList = CreateObject("Scripting.Dictionary")
    
16.    
    
17.     For lngRow = 2 To UBound(arr)
    
18.         strID = Trim(arr(lngRow, 5))
    
19.         strList = arr(lngRow, 7)
    
20.         objList(strID) = objList(strID) & strList & "|"
    
21.     Next
    
22.    
    
23.     arrKeys = objList.keys
    
24.     arrItems = objList.items
    
25.    
    
26.     Set Rg = shFolder.Range("O1") '将O列当作来源列
    
27.     For lngRow = LBound(arrItems) To UBound(arrItems)
    
28.         strSplit = Split(arrItems(lngRow), "|")
    
29.         Rg.Resize(UBound(strSplit), 1) = Application.WorksheetFunction.Transpose(strSplit)
    
30.         strID = arrKeys(lngRow)
    
31.         strList = "=" & strShName & "!" & Rg.Resize(UBound(strSplit), 1).Address
    
32.         Set Rg = Rg.Offset(UBound(strSplit), 0)
    
33.         objList(strID) = strList
    
34.     Next
    
35.    
    
36.     lngRow = shDoc.Range("C" & Rows.Count).End(xlUp).Row
    
37.     arr = shDoc.Range("C1:C" & lngRow)
    
38.    
    
39.     For lngRow = 2 To UBound(arr)
    
40.         strID = Trim(arr(lngRow, 1))
    
41.         If strID <> "" Then strList = objList(strID)
    
42.         With shDoc.Cells(lngRow, 4).Validation
    
43.             .Delete
    
44.             .Add Type:=xlValidateList, Formula1:=strList
    
45.         End With
    
46.     Next
    
47.    
    
48. End Sub

复制代码

OALD

lsdongjh 发表于 2018-8-31 14:13

谢谢！可否把代码贴出来让我试试看？