人员信息录入，求大神写信息汇总及生成唯一编码的代码？

rardge2015 · 发表于 2019-11-1 10:31

'多级下拉菜单
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a(), i
If Me.Name <> "信息录入" Then Me.Name = "信息录入"
On Error Resume Next
If Target.Column = 3 And Target.Row = 8 Then '指定 Range("C8")
If Target.Column = 1 Then '这条指令永远执行不到
With Application.CommandBars("myCell")
.ShowPopup
End With
ElseIf Target.Column <= 3 And Target.Column >= 2 Then
ReDim a(0 To Target.Column - 2)
For i = 2 To Target.Column
If Cells(Target.Row, i - 1) <> "" Then
a(i - 2) = Cells(Target.Row, i - 1)
End If
Next
Call SubPopBar(a)
End If
End If
End Sub

复制代码

以上代码想实现什么目的？

caizhiliang · 发表于 2019-11-1 12:13

本帖最后由 caizhiliang 于 2019-11-1 14:07 编辑

rardge2015 发表于 2019-11-1 10:31
以上代码想实现什么目的？

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

caizhiliang · 发表于 2019-11-1 12:15

本帖最后由 caizhiliang 于 2019-11-1 14:09 编辑

rardge2015 发表于 2019-11-1 10:31
以上代码想实现什么目的？

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

rardge2015 · 发表于 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年至今，并分组显示弹出菜单。工作簿打开时加载速度有些慢。

caizhiliang · 发表于 2019-11-1 19:27

本帖最后由 caizhiliang 于 2019-11-1 19:50 编辑

rardge2015 发表于 2019-11-1 15:31
抱歉，我没有看你最新版，上午回复了以后就出去接待了，午饭后还是在原来的基础上修改的。
本次代码改动的 ...

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

rardge2015 · 发表于 2019-11-1 21:41

在模块1中，把以下两段代码重贴一下即可。过程名称就不改了。
年份会自动增加的。For 循环中用的是函数 Year(Date)，取当天日期所在年份。

' 子过程：建立弹出菜单（年日月）
Sub Menu_Date(BarMain As CommandBar)
Dim BarDate As CommandBarPopup
Dim iYear As Integer
Set BarDate = BarMain.Controls.Add(Type:=msoControlPopup)
With BarDate
.caption = "年月日"
' 建立年份菜单项
For iYear = 2000 To Year(Date)
' 建立（月、日）子菜单项
Call Menu_Date_YearGroup(BarDate, iYear)
Next
End With
Set BarDate = Nothing
End Sub
' 根据年份，建立（月、日）子菜单项
Private Sub Menu_Date_YearGroup(BarParent As CommandBarPopup, iYear As Integer)
Dim BarYear As CommandBarPopup, BarMonth As CommandBarPopup, BarDay As CommandBarButton
Dim iMonth As Integer, iDay As Integer, iDayEnd As Integer
Set BarYear = BarParent.Controls.Add(Type:=msoControlPopup)
With BarYear
.caption = iYear
For iMonth = 1 To 12
Set BarMonth = .Controls.Add(Type:=msoControlPopup)
With BarMonth
.caption = iMonth
Select Case iMonth
Case 1, 3, 5, 7, 8, 10, 12: iDayEnd = 31
Case 4, 6, 9, 11: iDayEnd = 30
Case 2: iDayEnd = Day(DateSerial(iYear, 3, 0)) ' 解决闰年问题
End Select
For iDay = 1 To iDayEnd
Set BarDay = .Controls.Add(Type:=msoControlButton)
With BarDay
.caption = iDay
.OnAction = "Menu_Date_Write(" & iYear & "," & iMonth & "," & iDay & ")"
End With
Next
End With
Next
End With
End Sub

复制代码

caizhiliang · 发表于 2019-11-3 10:29

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

谢谢大神已经改好了感谢您的帮助！谢谢

caizhiliang · 发表于 2019-11-6 12:10

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

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

caizhiliang · 发表于 2019-11-6 14:13

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

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

rardge2015 · 发表于 2019-11-6 20:22

你加了密码。
代码是有这个功能的，我发现工作表是：删除学员，但在保存信息的代码中是：删除人员，也许就是这个原因。

		自动登录	找回密码
密码			注册

人员信息录入，求大神写信息汇总及生成唯一编码 的代码？

评分

人员信息录入，求大神写信息汇总及生成唯一编码的代码？