Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 4732|回复: 6

求助修改代码实现多级联动下拉菜单

[复制链接]
发表于 2020-5-19 11:35 | 显示全部楼层 |阅读模式
2学分
各位大佬好,

最近遇到一个情况,想用Excel做多级联动下拉菜单,琢磨了几天,从一开始做个下拉菜单都不咋熟,到后面用名称管理器做,再到现在想尝试用VBA做,遇到了各种各样的问题。

名称管理器里面的菜单内容不能包含空格、括号或者下划线,有的话,下一级的向下小箭头就没法点开。网上翻了一圈发现有的说下划线是没问题的,也确实看到了有个视频教程是带下划线的,无奈我怎么都实现不了,只好放弃。。。

现在用VBA的话,看到了一个大佬做的成品,附件奉上。这里是在一个区域内首行首列自动运行了一个下拉菜单,选择之后则自动跳转到右边一格,出现第二个下拉菜单。现在我想改成自动跳转到下面一格,简单说就是行列互换,不知道哪一位大佬能帮忙修改一下代码。拜谢

我想实现的功能主要是选价格,比如在国产或进口大类(第一级)里面,选国产。第二级选牛奶还是奶酪,选牛奶,右边一列应该就自动跳转出价格+50;选奶酪,右边一列就自动跳出价格+80。然后在三级菜单里可以选加糖或不加糖,牛奶加糖则右边自动跳出价格再+10;奶酪加糖则价格+20。四级是牛奶可以选加黑豆还是加红豆,黑豆10块钱,红豆12块钱。奶酪则没得选。最后下面出个价格汇总,选了国产牛奶加糖加黑豆的就是50+10+10=70。选了国产奶酪加糖的是100(这里奶酪没有黑豆红豆的选项,所以总计的价格如果不能自动在上面一行就不太美观)。
下面最好可以有个日期的选择框,记录一下文字描述,比如“2020年05月19日我吃了一份国产奶酪加糖,价格是100”。

以上的描述应该不用VBA就能做出来,有比较简单的方法,请求指点。我用名称管理器做的时候,主要遇到的问题是同样是加糖,牛奶加糖自动跳转出的价格得是10,而奶酪是20。所以我用了个取巧的法子,,牛奶加糖识别的字是“加糖”,奶酪加糖是“加糖 ”,多了个空格,但是名称管理器又不能有空格。因此不断被各种问题困扰。。。。不知道哪位能帮忙看看orz

Desktop.zip

24.31 KB, 下载次数: 22

最佳答案

查看完整内容

你测试下这个附件看看,我感觉大面上差不多,细节可能还需要推敲,因为你模拟的数据没有使用价值,看不出具体的效果来; 你原来的代码我全部删掉了,仅在change和selectchange中重写了代码; 有个模块1,是数据有效性的录制宏,我是想抄一下有效性的设置。录制宏得到的代码很长,不影响使用的参数都被删了,只保留了两个参数; 主要思路: 1、可以从 b 列开始一步步往下走,也可以直接进入到 b-f 列的任何一个单元格直接进行 ...
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2020-5-19 11:35 | 显示全部楼层
本帖最后由 hfwufanhf2006 于 2020-5-19 13:56 编辑

你测试下这个附件看看,我感觉大面上差不多,细节可能还需要推敲,因为你模拟的数据没有使用价值,看不出具体的效果来;
你原来的代码我全部删掉了,仅在change和selectchange中重写了代码;
有个模块1,是数据有效性的录制宏,我是想抄一下有效性的设置。录制宏得到的代码很长,不影响使用的参数都被删了,只保留了两个参数;

主要思路:
1、可以从 b 列开始一步步往下走,也可以直接进入到 b-f 列的任何一个单元格直接进行编辑(实际意义可能不大);
     如果是从b列开始,将会有每一步的具体检查,这个检查动作在 change 里:
       s1 = ""
       For i = 2 To Target.Column
         s1 = s1 & Cells(Target.Row, i)
       Next i

       这段代码是读出从b列开始到当前列的所有单元格的信息,并连成字符串;

      在后面读取源数据时:
       s4 = ""
       For k = 1 To Target.Column - 1
           s4 = s4 & Worksheets("下拉菜单源").Cells(i, k)
       Next k

       这段代码的结构与上面类似,它读出源数据的信息,这个信息要与上面的信息一致才会被采用,所以:
       If Not zd.exists(s) Then     '字典的作用只是排除重复值
          If s4 = s1 Then             '比较,相同的才会被写入变量 s2,s2后面会写入有效性
             zd(s) = i
             s2 = IIf(Len(s2) = 0, s3 & ",", s2 & s3 & ",")
          End If
       End If


2、如果是中途任选一个单元格,则是由 selectchange 负责检查,很显然这时不能触发 change,检查的过程略有不同:
       If Len(s1) = 0 Then              's1与上面的含义相同,也是 b-f 列的字符串集合
          If Not zd.exists(s3) Then
             zd(s3) = i
             s2 = IIf(Len(s2) = 0, s3 & ",", s2 & s3 & ",")
          End If
       Else
          If s4 = s1 Then
             If Not zd.exists(s3) Then
                zd(s3) = i
                s2 = IIf(Len(s2) = 0, s3 & ",", s2 & s3 & ",")
             End If
          End If
       End If


       这里主要的不同,就是当 b-c 列没有实际输入数据时,直接在 d 列编辑是能出现有效性列表的,所以对 if len(s1)=0 做了专门的处理。我不知道这个有没有用?我的想法是:先录入后面,在回到前面去录入也是可以的;

3、虽然你标注了编辑区是 b6:f25,但整个代码只有一个地方是明确标注了这个区域的,其他的地方仅仅只是限制编辑区是 b-f 列,至于行,代码允许任意行。我觉得你这只是个测试代码,也就没那么认真,留给你自己根据实际来调整;

副本a.rar

22.24 KB, 下载次数: 23

回复

使用道具 举报

 楼主| 发表于 2020-5-19 15:18 | 显示全部楼层
hfwufanhf2006 发表于 2020-5-19 13:53
你测试下这个附件看看,我感觉大面上差不多,细节可能还需要推敲,因为你模拟的数据没有使用价值,看不出具 ...

好像有点不太对,这次我换了模拟的数据,原来的确实看不出具体效果,不好意思。现在就清晰直观多了。然后我试了一下您的代码,限定在什么位置出现下拉菜单没了,感觉就不太好找到。原代码的话直接Private Const Rng1Address = "B6",那就只有B6有下拉菜单,而且背景也会是跟周围不一样的绿色做提示。
另外现在的话好像依然是选择了第一级菜单后,会自动跳转到右边一个格子,再选二级。不能跳转到下面的格子。而且不知道为啥如果我不选一级,就能看到二级能选哪些,这是不是就没有了多级联动的效果。。?而如果选了一级后,二级反而就只能有一个下拉选项,三级也是。好像坏掉了。

麻烦您查看一下(这里我最后增加了品类和价格的sheet,但是代码里的“下拉菜单源”字段还没改,大佬见谅。。。)


副本a(1).zip

20.71 KB, 下载次数: 20

回复

使用道具 举报

发表于 2020-5-19 16:32 | 显示全部楼层
矢泽妮可 发表于 2020-5-19 15:18
好像有点不太对,这次我换了模拟的数据,原来的确实看不出具体效果,不好意思。现在就清晰直观多了。然后 ...

1、你修改了工作表名称,调试阶段这个先不要改,还是用“下拉列表源”比较好。调试过后你再把代码涉及工作表名称的地方都改掉;
2、你把代码放在了sheet1表中,因此也需要在 sheet1中去执行;
3、代码有个错误,在change中:
       If Not zd.exists(s) Then
          If s4 = s1 Then
             zd(s) = i

     把变量 s 全部换成 s3,有两处需要修改:zd.exists(s) 和 zd(s) = i,之前我是用变量 s,后来变量不够用,就用了 s1-s4,这个地方忘记改了;
4、关于你说的“而且不知道为啥如果我不选一级,就能看到二级能选哪些”,这个在前面帖子我有说明:
     我的想法是:先录入后面,在回到前面去录入也是可以的;
     在 selectchang 中:
       If Len(s1) = 0 Then                             '表示前面都没输入,这里是允许先输入后面再补充前面内容的
          If Not zd.exists(s3) Then
             zd(s3) = i
             s2 = IIf(Len(s2) = 0, s3 & ",", s2 & s3 & ",")
          End If
       Else
          If s4 = s1 Then
             If Not zd.exists(s3) Then
                zd(s3) = i
                s2 = IIf(Len(s2) = 0, s3 & ",", s2 & s3 & ",")
             End If
          End If
       End If


       如果你觉得这样不严谨,就需要写成(我没实际调试,大概就是这样的):
       if len(s1)>0 then                   '排除上级没有输入的情况
          if s4=s1 then
             if not zd.exists(s3) then
                ....
             endif
          endif
        endif
        这个建议你最后再改,它不是关键点;
5、最后附三张截图:
     最后一张的 f 列为空,是因为你源数据只有4列,没有第5列;
     总体上我还是觉得你数据源不完整,导致额外的重复。如果你理解了关键点,你可以自行调整;

3.png
2.png
1.png
回复

使用道具 举报

 楼主| 发表于 2020-5-19 20:30 | 显示全部楼层
hfwufanhf2006 发表于 2020-5-19 16:32
1、你修改了工作表名称,调试阶段这个先不要改,还是用“下拉列表源”比较好。调试过后你再把代码涉及工 ...

您说的第一个,我还是能明白的,这个不影响。我主要是在两台电脑上来搞这个事,所以一边改了,另一边没改。这一步我还能明白~~

按您第三点所说的,两处代码修改了一下,果然就能正确运行了,感谢~!!

第四点确实,但是我主要考虑到,比如这是个省市县,这种样式的联动,如果先输入了市县,再去选省,就错了。我明白咱俩想法的区别了,您是以数据录入来考虑的,但是其实我的想法是用这个来填表。这一段对于我来说理解起来就真的很吃力了。。。基本处于完全看不懂。不知道大佬能不能加个联系方式,QQVX啥的,这样沟通起来更有效率一点,不然我感觉五分钟能聊完的事,我还得继续痛苦好几天。
晚上我干脆从网上扒了一段具有实际意义的完整的数据源。想请大佬赐教orz。。。。。。另外我最想实现的功能是竖着填,而不是现在这样横着去填。

大佬辛苦了
回复

使用道具 举报

发表于 2020-5-19 23:20 | 显示全部楼层
矢泽妮可 发表于 2020-5-19 20:30
您说的第一个,我还是能明白的,这个不影响。我主要是在两台电脑上来搞这个事,所以一边改了,另一边没改 ...

下面这段稍微改下,基本就能满足你要求:
       If Len(s1) = 0 Then                             '表示前面都没输入,这里是允许先输入后面再补充前面内容的
          If Not zd.exists(s3) Then
             zd(s3) = i
             s2 = IIf(Len(s2) = 0, s3 & ",", s2 & s3 & ",")
          End If
       Else
          If s4 = s1 Then
             If Not zd.exists(s3) Then
                zd(s3) = i
                s2 = IIf(Len(s2) = 0, s3 & ",", s2 & s3 & ",")
             End If
          End If
       End If

改成:
       if len(s1)>0 then                   '排除上级没有输入的情况
          if s4=s1 then
             if not zd.exists(s3) then
                zd(s3) = i
                s2 = IIf(Len(s2) = 0, s3 & ",", s2 & s3 & ",")
             endif
          endif
        endif

就是把前半段允许上级没有录入的情况去掉就可以了;

回复

使用道具 举报

发表于 2020-5-20 13:08 | 显示全部楼层
每次点击单元格时都去扫描一遍「品类」工作表效率太低。
应该采用这种方式:
只使用一个字典只扫描一遍「品类」工作表,记录下所有的Key,然后在必要时更新下字典。
这样,即使有20万条Key也不会感到丝毫的卡顿。

单个字典多级下拉菜单V1_20200520124353.gif
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 20:45 , Processed in 0.332277 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表