Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
楼主: caizhiliang

[已解决] 人员信息录入,求大神写信息汇总及生成唯一编码 的代码?

[复制链接]
发表于 2019-11-1 10:31 | 显示全部楼层
  1. '多级下拉菜单
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3.     Dim a(), i
  4.    
  5.     If Me.Name <> "信息录入" Then Me.Name = "信息录入"

  6.     On Error Resume Next
  7.     If Target.Column = 3 And Target.Row = 8 Then    '指定 Range("C8")
  8.         If Target.Column = 1 Then                   '这条指令永远执行不到
  9.             With Application.CommandBars("myCell")
  10.                 .ShowPopup
  11.             End With
  12.         ElseIf Target.Column <= 3 And Target.Column >= 2 Then
  13.             ReDim a(0 To Target.Column - 2)
  14.             For i = 2 To Target.Column
  15.                 If Cells(Target.Row, i - 1) <> "" Then
  16.                     a(i - 2) = Cells(Target.Row, i - 1)
  17.                 End If
  18.             Next
  19.             Call SubPopBar(a)
  20.         End If
  21.     End If
  22. End Sub
复制代码

以上代码想实现什么目的?
回复

使用道具 举报

 楼主| 发表于 2019-11-1 12:13 | 显示全部楼层
本帖最后由 caizhiliang 于 2019-11-1 14:07 编辑
rardge2015 发表于 2019-11-1 10:31
以上代码想实现什么目的?

那段代码是科目输入的多级下拉菜单    因为是搬别人的代码过来的  所以里面或多或少有一些杂质    换了一个思路解决问题    改了这个文件就完成了  就可以投入使用了

学员信息录入表格7 .0大版本变革.zip

650.19 KB, 下载次数: 0

回复

使用道具 举报

 楼主| 发表于 2019-11-1 12:15 | 显示全部楼层
本帖最后由 caizhiliang 于 2019-11-1 14:09 编辑
rardge2015 发表于 2019-11-1 10:31
以上代码想实现什么目的?

这个代码主要是从科目信息拉取数值到 c8 单元格多级下拉菜单的
回复

使用道具 举报

发表于 2019-11-1 15:31 | 显示全部楼层
抱歉,我没有看你最新版,上午回复了以后就出去接待了,午饭后还是在原来的基础上修改的。
本次代码改动的地方:
ThisWorkbook:Workbook_Open()
信息录入表:Worksheet_SelectionChange()
模块 1 新建以下过程:
Sub Menu_Date
Sub Menu_Date_YearGroup
Sub Menu_Date_Write
模块 1 修改以下过程:Sub Record_Save

因为有一个日期是“生日”,所以年份需求很宽,我定义从1960年至今,并分组显示弹出菜单。工作簿打开时加载速度有些慢。

学员信息录入表格7 .0大版本变革.zip

631.21 KB, 下载次数: 5

回复

使用道具 举报

 楼主| 发表于 2019-11-1 19:27 | 显示全部楼层
本帖最后由 caizhiliang 于 2019-11-1 19:50 编辑
rardge2015 发表于 2019-11-1 15:31
抱歉,我没有看你最新版,上午回复了以后就出去接待了,午饭后还是在原来的基础上修改的。
本次代码改动的 ...

大神您好   感谢您的帮助  我们做的是幼儿、小学的培训   所以日期的宽度不需要那么长   从2000开始已经是很方便了   也是我没有讲清楚,如果要修改为2000年开始可以吗   不需要分组,我们跨越的年龄阶段就20年,还有一个疑问就是   2019年后面   2020年  到时日期会出来吗   还是只是截止到2019年
回复

使用道具 举报

发表于 2019-11-1 21:41 | 显示全部楼层
在模块1中,把以下两段代码重贴一下即可。过程名称就不改了。
年份会自动增加的。For 循环中用的是函数 Year(Date),取当天日期所在年份。
  1. ' 子过程:建立弹出菜单(年日月)
  2. Sub Menu_Date(BarMain As CommandBar)
  3.     Dim BarDate As CommandBarPopup
  4.     Dim iYear As Integer
  5.    
  6.     Set BarDate = BarMain.Controls.Add(Type:=msoControlPopup)
  7.     With BarDate
  8.         .caption = "年月日"
  9.         
  10.         ' 建立 年份 菜单项
  11.         For iYear = 2000 To Year(Date)
  12.             ' 建立(月、日)子菜单项
  13.             Call Menu_Date_YearGroup(BarDate, iYear)
  14.         Next
  15.     End With
  16.    
  17.     Set BarDate = Nothing
  18. End Sub

  19. ' 根据年份,建立(月、日)子菜单项
  20. Private Sub Menu_Date_YearGroup(BarParent As CommandBarPopup, iYear As Integer)
  21.     Dim BarYear As CommandBarPopup, BarMonth As CommandBarPopup, BarDay As CommandBarButton
  22.     Dim iMonth As Integer, iDay As Integer, iDayEnd As Integer

  23.     Set BarYear = BarParent.Controls.Add(Type:=msoControlPopup)
  24.     With BarYear
  25.         .caption = iYear
  26.         For iMonth = 1 To 12
  27.             Set BarMonth = .Controls.Add(Type:=msoControlPopup)
  28.             With BarMonth
  29.                 .caption = iMonth
  30.                 Select Case iMonth
  31.                     Case 1, 3, 5, 7, 8, 10, 12: iDayEnd = 31
  32.                     Case 4, 6, 9, 11: iDayEnd = 30
  33.                     Case 2: iDayEnd = Day(DateSerial(iYear, 3, 0))  ' 解决闰年问题
  34.                 End Select
  35.                 For iDay = 1 To iDayEnd
  36.                     Set BarDay = .Controls.Add(Type:=msoControlButton)
  37.                     With BarDay
  38.                         .caption = iDay
  39.                         .OnAction = "Menu_Date_Write(" & iYear & "," & iMonth & "," & iDay & ")"
  40.                     End With
  41.                 Next
  42.             End With
  43.         Next
  44.     End With
  45. End Sub
复制代码

评分

参与人数 1学分 +2 收起 理由
caizhiliang + 2 学习

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2019-11-3 10:29 | 显示全部楼层
rardge2015 发表于 2019-11-1 21:41
在模块1中,把以下两段代码重贴一下即可。过程名称就不改了。
年份会自动增加的。For 循环中用的是函数 Ye ...

谢谢大神  已经改好了   感谢您的帮助!谢谢
回复

使用道具 举报

 楼主| 发表于 2019-11-6 12:10 | 显示全部楼层
rardge2015 发表于 2019-11-1 21:41
在模块1中,把以下两段代码重贴一下即可。过程名称就不改了。
年份会自动增加的。For 循环中用的是函数 Ye ...

大神您好   测试了几天   有一个问题 需要您再次相助  修改下   就是被删除的学员 再次读取保存到其它档案后   删除人员里面的数据没有相对应的删除,能否修改  被删除的数据 再次提取出来后  保存到(新生、老生等)之后    被删除的表格里面那条记录要相应的删除
感谢您的帮助  谢谢

学员信息录入表格9.0版本.zip

888.06 KB, 下载次数: 1

回复

使用道具 举报

 楼主| 发表于 2019-11-6 14:13 | 显示全部楼层
rardge2015 发表于 2019-11-1 21:41
在模块1中,把以下两段代码重贴一下即可。过程名称就不改了。
年份会自动增加的。For 循环中用的是函数 Ye ...

还有一点哦   就是被删除人员回复后 ,被删除的学员档案还存在“被删除的表格里面”,其它地方也有这个学员  同时编号重复存在
回复

使用道具 举报

发表于 2019-11-6 20:22 | 显示全部楼层
你加了密码。
代码是有这个功能的,我发现工作表是:删除学员,但在保存信息的代码中是:删除人员,也许就是这个原因。
回复

使用道具 举报

*滑块验证:
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2020-8-4 18:54 , Processed in 0.078000 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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