[已解决]单元格数据有效性序列联动

心灵之舞

在B1和C1中构建有效序列，B1取B列不重复，C1取C列不重复，且B1和C1单元格联动。
等级中序列最好按特级、1级、2级、3级、4级进行排序。
请论坛里的老师帮忙用VBA解答，谢谢！ 数据有效性去重联动.rar (15.88 KB, 下载次数: 73)

2014-10-18 23:28 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-10-19 10:39

1. Private Sub Workbook_Open()
   
2. Call aa
   
3. End Sub
   
4. Public d, d2, arr
   
5. Sub aa()
   
6. arr = Range("a3").CurrentRegion
   
7. Set d = CreateObject("Scripting.Dictionary")
   
8. Set d2 = CreateObject("Scripting.Dictionary")
   
9. For i = 2 To UBound(arr)
   
10.     zf = arr(i, 2) & "," & arr(i, 3)
    
11.     If Not d.exists(arr(i, 2)) Then
    
12.         d(arr(i, 2)) = arr(i, 3)
    
13.     Else
    
14.         d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 3)
    
15.     End If
    
16.     If Not d2.exists(zf) Then
    
17.         d2(zf) = arr(i, 4)
    
18.     Else
    
19.         d2(zf) = d2(zf) & "," & arr(i, 4)
    
20.     End If
    
21. Next
    
22. End Sub
    
23. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
24. If Target.Address = "$B$1" Then
    
25.     With Target.Validation
    
26.         .Delete
    
27.         .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
    
28.     End With
    
29. End If
    
30. If Target.Address = "$C$1" Then
    
31.     With Target.Validation
    
32.         .Delete
    
33.         .Add Type:=xlValidateList, Formula1:=d([b1].Value)
    
34.     End With
    
35. End If
    
36. If Target.Address = "$D$1" Then
    
37.     With Target.Validation
    
38.         .Delete
    
39.         .Add Type:=xlValidateList, Formula1:=d2([b1].Value & "," & [c1].Value)
    
40.     End With
    
41. End If
    
42. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

1. Private Sub Workbook_Open()
   
2. Call aa
   
3. End Sub
   
4. Public d, arr
   
5. Sub aa()
   
6. arr = Range("a3").CurrentRegion
   
7. Set d = CreateObject("Scripting.Dictionary")
   
8. For i = 2 To UBound(arr)
   
9.     If Not d.exists(arr(i, 2)) Then
   
10.         d(arr(i, 2)) = arr(i, 3)
    
11.     Else
    
12.         d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 3)
    
13.     End If
    
14. Next
    
15. End Sub
    
16. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
17. If Target.Address = "$B$1" Then
    
18.     With Target.Validation
    
19.         .Delete
    
20.         .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
    
21.     End With
    
22. End If
    
23. If Target.Address = "$C$1" Then
    
24.     With Target.Validation
    
25.         .Delete
    
26.         .Add Type:=xlValidateList, Formula1:=d([b1].Value)
    
27.     End With
    
28. End If
    
29. End Sub

复制代码

dsmch

………………

心灵之舞

谢谢dsmch老师！问题已解决！如果变成三个单元格联动该如何做呀！谢谢了！ 数据有效性去重联动.rar (11.21 KB, 下载次数: 43)

2014-10-19 10:24 上传

点击文件名下载附件
在d1中增加了对D列的有效性。还请老师帮忙！

dsmch

1. Private Sub Workbook_Open()
   
2. Call aa
   
3. End Sub
   
4. Public d, d2, arr
   
5. Sub aa()
   
6. arr = Range("a3").CurrentRegion
   
7. Set d = CreateObject("Scripting.Dictionary")
   
8. Set d2 = CreateObject("Scripting.Dictionary")
   
9. For i = 2 To UBound(arr)
   
10.     zf = arr(i, 2) & "," & arr(i, 3)
    
11.     If Not d.exists(arr(i, 2)) Then
    
12.         d(arr(i, 2)) = arr(i, 3)
    
13.     Else
    
14.         d(arr(i, 2)) = d(arr(i, 2)) & "," & arr(i, 3)
    
15.     End If
    
16.     If Not d2.exists(zf) Then
    
17.         d2(zf) = arr(i, 4)
    
18.     Else
    
19.         d2(zf) = d2(zf) & "," & arr(i, 4)
    
20.     End If
    
21. Next
    
22. End Sub
    
23. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
24. If Target.Address = "$B$1" Then
    
25.     With Target.Validation
    
26.         .Delete
    
27.         .Add Type:=xlValidateList, Formula1:=Join(d.keys, ",")
    
28.     End With
    
29. End If
    
30. If Target.Address = "$C$1" Then
    
31.     With Target.Validation
    
32.         .Delete
    
33.         .Add Type:=xlValidateList, Formula1:=d([b1].Value)
    
34.     End With
    
35. End If
    
36. If Target.Address = "$D$1" Then
    
37.     With Target.Validation
    
38.         .Delete
    
39.         .Add Type:=xlValidateList, Formula1:=d2([b1].Value & "," & [c1].Value)
    
40.     End With
    
41. End If
    
42. End Sub
    

复制代码

dsmch

1. 论坛原因，重复发帖了，删除

复制代码

心灵之舞

dsmch 发表于 2014-10-19 10:39

谢谢dsmch老师！问题已解决，但又遇到新的问题，整了一下，一直不成功，能否麻烦您再帮忙看下。
就是B1、C1不用序列，D1增加序列且不重复。D1序列根据B1、C1内容而变化。
因字典掌握不太好，还请老师帮忙处理下。 数据有效性去重联动1.rar (11.07 KB, 下载次数: 27)

2014-10-19 20:05 上传

点击文件名下载附件

excel_qj

dsmch 发表于 2014-10-19 05:09
………………

若是在D和E列中构建有效序列，D取B列不重复，E取C列不重复，且D和E单元格联动，如D1和E1联动，D2和E2联动。
这个需要如何循环呢？
麻烦老师帮忙解答下，谢谢