[已解决][求助]将符合左单元格条件的单元格生成右单元格的下拉菜单

cloudliumy

求助各位大侠，标题可能比较难懂，但是我实在想不出来如何描述这个要求。

问题描述

如图所示，B C列是数据源，现在需要在E列输入B列的号码，然后在F列生成的下拉菜单里自动生成满足B列的条件的C列内容。
如果E2=2000100071，那么F2的下拉菜单里就是DIO0001~0004。
如果E3=2000100077，那么F3的下拉菜单就是DIO0001\0002\0004。
-
考虑过用名称管理器，但是B列和C列的数据会一直增加。而且，B列的数据保守估计要有600~700个。做这么多名称实在……
其实就是F2的数据有效性下拉菜单是B列里所有=F2单元格的对应C列的数据list。
不知道有什么方法能够实现。

谢谢各位大侠。 下拉菜单.zip (8.52 KB, 下载次数: 4)

2016-4-12 13:40 上传

点击文件名下载附件
附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-12 14:55

代码小改了一下，二级菜单去重。
加了说明。

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub      '选择单元格数超过1个，退出
   
3.     c = Target.Column    'c=单元格列
   
4.     If c < 5 Or c > 6 Then Exit Sub    '非5非6列，退出
   
5.     Set d = CreateObject("scripting.dictionary")     '设立字典d
   
6.     arr = [b1].CurrentRegion    '源数据
   
7.     For i = 1 To UBound(arr)
   
8.         x = arr(i, 1)     '第一列为key
   
9.         If InStr(d(x), arr(i, 2)) = 0 Then d(x) = d(x) & "," & arr(i, 2)      '第二列去重为item
   
10.     Next
    
11.    
    
12.     '如果单元格在第5列，以字典的key相连为有效性，否则以第五列的key对应的item为有效性
    
13.     xstr = IIf(c = 5, Join(d.keys, ","), Mid(d(Target.Offset(0, -1).Value), 2))
    
14.    
    
15.     If Len(xstr) Then     '如果有效性非空，建立有效性
    
16.         With Target.Validation     '建立有效性的固定语句
    
17.             .Delete
    
18.             .Add xlValidateList, , , xstr
    
19.         End With
    
20.     End If
    
21. End Sub

复制代码

跳转到最佳答案楼层

grf1973

就是一个简单的二级下拉菜单啦。

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     c = Target.Column
   
4.     If c < 5 Or c > 6 Then Exit Sub
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     arr = [b1].CurrentRegion
   
7.     For i = 1 To UBound(arr)
   
8.         d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)
   
9.     Next
   
10.     xstr = IIf(c = 5, Join(d.keys, ","), Mid(d(Target.Offset(0, -1).Value), 2))
    
11.     If Len(xstr) Then
    
12.         With Target.Validation
    
13.             .Delete
    
14.             .Add xlValidateList, , , xstr
    
15.         End With
    
16.     End If
    
17. End Sub
    

复制代码

cloudliumy

grf1973 发表于 2016-4-12 14:21
就是一个简单的二级下拉菜单啦。

大神，能给讲解一下吗？ 我上传的只是个例子，我还要转移到我自己的表里的。
多谢大神了{:021:}

grf1973

如果会字典，不讲也懂，否则讲也不懂。

grf1973

干脆把你自己的表发上来得了

grf1973

代码小改了一下，二级菜单去重。
加了说明。

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub      '选择单元格数超过1个，退出
   
3.     c = Target.Column    'c=单元格列
   
4.     If c < 5 Or c > 6 Then Exit Sub    '非5非6列，退出
   
5.     Set d = CreateObject("scripting.dictionary")     '设立字典d
   
6.     arr = [b1].CurrentRegion    '源数据
   
7.     For i = 1 To UBound(arr)
   
8.         x = arr(i, 1)     '第一列为key
   
9.         If InStr(d(x), arr(i, 2)) = 0 Then d(x) = d(x) & "," & arr(i, 2)      '第二列去重为item
   
10.     Next
    
11.    
    
12.     '如果单元格在第5列，以字典的key相连为有效性，否则以第五列的key对应的item为有效性
    
13.     xstr = IIf(c = 5, Join(d.keys, ","), Mid(d(Target.Offset(0, -1).Value), 2))
    
14.    
    
15.     If Len(xstr) Then     '如果有效性非空，建立有效性
    
16.         With Target.Validation     '建立有效性的固定语句
    
17.             .Delete
    
18.             .Add xlValidateList, , , xstr
    
19.         End With
    
20.     End If
    
21. End Sub

复制代码

cloudliumy

grf1973 发表于 2016-4-12 14:55
代码小改了一下，二级菜单去重。
加了说明。

多谢大神，源文件在公司电脑里，有加密程序。
谢谢大神讲解。