ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 135|回复: 9

[求助] 代码问题

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-30 20:27 | 显示全部楼层 |阅读模式
物品出入库存表代码出错,然后本期学员名单下拉菜单仅限C3表格,要修改代码,谢谢老师

蓝泰学校-学员登记库存(正式版).zip

59.09 KB, 下载次数: 4

TA的精华主题

TA的得分主题

发表于 2020-1-30 20:51 | 显示全部楼层
楼主雷同问题已经问过了,参考之前的案例看看吧

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-30 21:09 | 显示全部楼层
liulang0808 发表于 2020-1-30 20:51
楼主雷同问题已经问过了,参考之前的案例看看吧

老师下拉选项已经会修改了,其它工作表的下拉效果都已经会改参数了,这次的问题是只要在制定的单元格实现下拉选项,不知道怎么改代码了

TA的精华主题

TA的得分主题

发表于 2020-1-30 21:28 | 显示全部楼层
深秋红叶2019 发表于 2020-1-30 21:09
老师下拉选项已经会修改了,其它工作表的下拉效果都已经会改参数了,这次的问题是只要在制定的单元格实现 ...

仅仅是C3,手动设置是否可以?
其他会设置,单独设置一个C3的难点在哪里,楼主是差哪一步不了解?

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-30 21:35 | 显示全部楼层
liulang0808 发表于 2020-1-30 21:28
仅仅是C3,手动设置是否可以?
其他会设置,单独设置一个C3的难点在哪里,楼主是差哪一步不了解?

If t.Row > 1 And t.Column = 3 Then   这个代码会把整个c列做成下拉选项效果,只要C3有就可以,数据有效性不太好,后面加数据的话下拉菜单就不会显示了
Dim sht As Worksheet, arr, d As Object, i%, s, r, r1, s1
         Set sht = Sheets("数据有效性")
         r = sht.Cells(Rows.Count, 1).End(3).Row
         arr = sht.Range("a1:a" & r)
         Set d = CreateObject("scripting.dictionary")
         For i = 2 To UBound(arr)
               s = arr(i, 1)
               If Not d.exists(s) Then
                    d(s) = ""
               End If
          Next i
          With Sheets("本期学员名单").Cells(t.Row, t.Column).Validation '在区域制作筛选下拉菜单
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
         End With
         Erase arr: Set d = Nothing
    End If
End Sub

TA的精华主题

TA的得分主题

发表于 2020-1-30 21:38 | 显示全部楼层
With Sheets("本期学员名单").[C3].Validation '在区域制作筛选下拉菜单
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
         End With

楼主看看这样修改是否满足需求吧

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-30 21:42 | 显示全部楼层
liulang0808 发表于 2020-1-30 21:28
仅仅是C3,手动设置是否可以?
其他会设置,单独设置一个C3的难点在哪里,楼主是差哪一步不了解?

还有那个“物品出入库记录”工作表显示方法和数据成员为找到,好像是Listbox1

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-30 21:48 | 显示全部楼层
liulang0808 发表于 2020-1-30 21:38
With Sheets("本期学员名单").[C3].Validation '在区域制作筛选下拉菜单
             .Delete
          ...

好像多了7个表格有下拉菜单

TA的精华主题

TA的得分主题

发表于 2020-1-30 22:03 | 显示全部楼层
深秋红叶2019 发表于 2020-1-30 21:48
好像多了7个表格有下拉菜单

楼主要做一个系统类的东西,建议提前规划好
6楼的修改就是在很对Sheets("本期学员名单").[C3],这个一个单元格的

下面修改了事件,供参考
另外arr = sht.Range("a2:a" & r)如果是没有重复的,可以数组转一维数组直接使用。不用使用字典去重了
Private Sub Worksheet_Activate()
        Dim sht As Worksheet, arr, d As Object, i%, s, r, r1, s1
         Set sht = Sheets("数据有效性")
         r = sht.Cells(Rows.Count, 1).End(3).Row
         arr = sht.Range("a2:a" & r)
         Set d = CreateObject("scripting.dictionary")
         For i = 2 To UBound(arr)
               s = arr(i, 1)
               If Not d.exists(s) Then
                    d(s) = ""
               End If
          Next i
          With Sheets("本期学员名单").[c3].Validation '在区域制作筛选下拉菜单
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
         End With
         Erase arr: Set d = Nothing

End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-31 09:09 | 显示全部楼层
深秋红叶2019 发表于 2020-1-30 21:35
If t.Row > 1 And t.Column = 3 Then   这个代码会把整个c列做成下拉选项效果,只要C3有就可以,数据有效 ...

谢谢老师,已经可以了,非常感谢:handshake:handshake
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-4-5 14:43 , Processed in 0.086106 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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