求助人员卡片保存的问题

抽屉123

我是想通过一个保存工作表把信息保存到“人员卡片”里面。我在附件里面有描述。谢谢！



                               附件： 卡片保存.zip (15.05 KB, 下载次数: 4)

2018-9-5 20:31 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim rng As Range
   
5.   With Worksheets("保存")
   
6.     ks = .Range("e5")
   
7.     arr = .Range("g12:g17")
   
8.     yf = Application.Choose(Month(arr(1, 1)), "一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "十一", "十二") & "月份"
   
9.     ts = Day(arr(1, 1))
   
10.   End With
    
11.   With Worksheets("人员卡片")
    
12.     Set rng = .Columns(1).Find(what:=yf, LookIn:=xlValues, lookat:=xlWhole)
    
13.     If rng Is Nothing Then
    
14.       MsgBox "没有该月份数据！"
    
15.       Exit Sub
    
16.     End If
    
17.     r = rng.Row - 2
    
18.     Set rng = .Rows(r).Find(what:=ks, LookIn:=xlValues, lookat:=xlWhole)
    
19.     If rng Is Nothing Then
    
20.       MsgBox "没有该科室数据！"
    
21.       Exit Sub
    
22.     End If
    
23.     c = rng.Column
    
24.     .Cells(r + ts + 1, c + 1) = arr(3, 1)
    
25.     .Cells(r + ts + 1, c + 2) = arr(5, 1)
    
26.     .Cells(r + ts + 1, c + 3) = arr(4, 1)
    
27.     .Cells(r + ts + 1, c + 4) = arr(6, 1)
    
28.    
    
29.   End With
    
30. End Sub
    

复制代码

chxw68

详见附件。