求助老师，excel模板批量生产sheet工作表。

忙昏头

求助老师，我是一个初学小白，想实现按excel模板批量生产sheet工作表，目前代码功不完善，请老师帮忙指教。1.运行时发现信息表中第5行马春芬和40行马建明只有一行，但在运行后药物名称规格出现其他行的（可能其他也有问题）；2.不能全部按病员姓名生产工作表。谢谢。

zxsea_7426

附件仅供参考：

忙昏头

zxsea_7426 发表于 2023-2-25 18:10
附件仅供参考：

收到，谢谢老师。

sxbjzjf110

参与一下，请参考。

sxbjzjf110

参与一下，请参考。

忙昏头

sxbjzjf110 发表于 2023-2-25 23:11
参与一下，请参考。

收到，非常感谢老师。

sxbjzjf110

重新写了一下，运行比之前的能快一些

忙昏头

sxbjzjf110 发表于 2023-2-26 15:01
重新写了一下，运行比之前的能快一些

非常感谢老师，正在学习第一个代码呢，想把处方号添加进去，出现问题。

忙昏头

忙昏头 发表于 2023-2-26 19:08
非常感谢老师，正在学习第一个代码呢，想把处方号添加进去，出现问题。

1. Sub test()
   
2.     Dim Arr, i, r, n
   
3.     Dim d As Object
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Arr = Sheets("信息").Range("A1").CurrentRegion
   
6.     For i = 2 To UBound(Arr)
   
7.         d(Arr(i, 1)) = ""
   
8.     Next
   
9.     r = Sheets("信息").Range("a1048576").End(xlUp).Row
   
10.     For Each wb In d.keys
    
11.         Sheets("模板").Copy after:=Sheets(Sheets.Count)
    
12.         ActiveSheet.Name = wb
    
13.         ActiveSheet.Range("b12:k32").Clear
    
14.         r = 12
    
15.         For i = 2 To UBound(Arr)
    
16.             If ActiveSheet.Name = Arr(i, 1) Then
    
17.                 [c4] = Arr(i, 1): [g4] = Arr(i, 2): [j4] = Arr(i, 3)
    
18.                 [c5] = [i1]: [g5] = "病人类型": [j5] = "科别": [c6] = "医疗证号"
    
19.                 [g6] = Arr(i, 13): [c7] = "临床诊断": [c8] = Arr(i, 5): [c9] = "备注": [g9] = Arr(i, 4)
    
20.                 [i1] = FormatArr[i,13]&"yyyymmdd") & Format(处方序号, "000000")
    
21.                 [i36] = Arr(i, 16): [b38] = Arr(i, 15): [g38] = Arr(i, 15)
    
22.                 Cells(r + n, 2) = Arr(i, 8) & Arr(i, 9) & "*" & Arr(i, 12): Cells(r + n + 1, 2) = Arr(i, 11)
    
23.                 n = Range("b32").End(xlUp).Row - 11
    
24.             End If
    
25.             处方序号 = 处方序号 + 1
    
26.         Next
    
27.         
    
28.         n = 0
    
29.     Next
    
30. End Sub
    

复制代码

忙昏头

忙昏头 发表于 2023-2-26 19:08
非常感谢老师，正在学习第一个代码呢，想把处方号添加进去，出现问题。

老师，想把处方号添加进去，出现问题。