一个表格录入培训人员名单，想对应每个人员生成一条培训记录

T天方夜谭

表格一复选框下拉菜单录入培训人员

想对应张三的个人资料中自动增加培训记录

想对应张三的个人资料中自动增加培训记录，同样李四王二的也自动增加记录





小女子谢过各位大神

sunya_0529

请上传一个附件上来，不能让帮忙的人帮你打字吧。

T天方夜谭

sunya_0529 发表于 2015-12-1 11:58
请上传一个附件上来，不能让帮忙的人帮你打字吧。

好的，先谢过~~~ 例子.zip (7.97 KB, 下载次数: 73)

2015-12-1 14:43 上传

点击文件名下载附件

T天方夜谭

求高手解答啊

T天方夜谭

求求求~~~不知道怎么做 求教啊

T天方夜谭

在线等~~~

sunya_0529

T天方夜谭 发表于 2015-12-1 16:26
在线等~~~

这个需求用公式是不容易实现的，借助于VBA会方便很多。

稍等帮你做个宏。

sunya_0529

T天方夜谭 发表于 2015-12-1 15:56
求求求~~~不知道怎么做 求教啊

宏代码如下所示——

1. Option Explicit
   
2. 
   
3. Sub SyncData()
   
4. Application.ScreenUpdating = False '关闭屏幕刷新
   
5. Dim rng As Range, arr, i%, j%, wst As Worksheet, w As Worksheet
   
6. With ActiveSheet
   
7.   For Each rng In .Range("E2:E" & .[E2].End(xlDown).Row)
   
8.     arr = Split(Replace(rng.Value, ",", "，"), "，") '提取培训人员到数组，并做中西文逗号的排错兼容处理
   
9.     For i = 0 To UBound(arr)
   
10.       j = 0
    
11.       For Each w In ThisWorkbook.Sheets '检测是否存在子表
    
12.         If w.Name = arr(i) Then j = j + 1
    
13.       Next
    
14.       If j > 0 Then '存在子表则在子表内添加数据
    
15.         Set wst = Sheets(arr(i))
    
16.       Else '不存在子表则新建子表，并以姓名命名
    
17.         Set wst = ThisWorkbook.Sheets.Add(after:=Sheets(ThisWorkbook.Sheets.Count))
    
18.         wst.Name = arr(i)
    
19.       End If
    
20.       If Application.CountIf(.Range(.[E2], rng), "*" & arr(i) & "*") = 1 Then '初始化分表
    
21.         wst.Cells.ClearContents
    
22.         wst.[A1:D1] = Array("课程代码", "课程名称", "培训单位", "培训时间")
    
23.       End If
    
24.       rng.Offset(0, -4).Resize(1, 4).Copy wst.[A65536].End(xlUp).Offset(1, 0) '以复制的方式分发数据
    
25.     Next i
    
26.   Next
    
27.   .Activate
    
28.   Application.CutCopyMode = False '关闭复制模式
    
29.   Set wst = Nothing
    
30. End With
    
31. Application.ScreenUpdating = True '打开屏幕刷新
    
32. End Sub

复制代码

T天方夜谭

sunya_0529 发表于 2015-12-1 22:08
宏代码如下所示——

艾玛~~感激涕零，泪流得不行不行的~~~太谢谢了~~~

T天方夜谭

sunya_0529 发表于 2015-12-1 22:08
宏代码如下所示——

1.打开开发工具的VISUAL basic 把代码复制进去保存为.xlsm文件，这样的操作正确吗，好像没有反应呢
2.可不可以输入信息以后加一个“确认“按钮，点击确认后面的表格就自动生成或者更新

3.例子里的项目主要是

课程代码

课程名称

培训单位

培训时间

培训人员

如果我要增加比如说”是否取得证书“”证书编号“等等项目，是不是修改为        wst.[A1:D1] = Array("课程代码", "课程名称", "培训单位", "培训时间"，”是否取得证书“”证书编号“)
      End If
      rng.Offset(0, -6).Resize(1, 6).Copy wst.[A65536].End(xlUp).Offset(1, 0) '以复制的方式分发数据


O(∩_∩)O谢谢~~~感激不尽，帮了小姑娘大忙