求教将Excel的每一条数据转换成多个Excel表【高难】

eikok

求教将Excel的每一条数据转换成多个Excel表
一条数据，自动填写到Excel表中对应的位置，形成多个Excel文件
多条数据.zip (7.46 KB, 下载次数: 9)

2020-2-16 12:33 上传

点击文件名下载附件

数据自动生成到表中.zip (9.05 KB, 下载次数: 12)

2020-2-16 12:33 上传

点击文件名下载附件

Nonenever

做了一下
感觉数据多了要运行的慢一点

1. Sub 个人健康信息报告表更新()
   
2.     Application.ScreenUpdating = False                       '关闭屏幕更新
   
3.     On Error Resume Next
   
4.     Application.DisplayAlerts = False
   
5.     Dim folder As String
   
6.     folder = ThisWorkbook.Path & "\个人健康信息报告表文件夹"               '保存工作簿文件的目录
   
7.     If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder   '选择是否新建该文件夹
   
8.     Dim sht As Worksheet
   
9.       
   
10.    
    
11.     Dim i%, 数据行数, sname
    
12.    
    
13.    
    
14.     数据行数 = Sheets("数据").Range("B" & Rows.Count).End(xlUp).Row
    
15.    
    
16.    
    
17.     If 数据行数 < 2 Then
    
18.    
    
19.    
    
20.     MsgBox "无数据！"
    
21.         Application.ScreenUpdating = True                           '开启屏幕更新
    
22.         Application.DisplayAlerts = True
    
23.     Exit Sub
    
24.    
    
25.     End If
    
26.    
    
27.    
    
28. 
    
29. 
    
30. For i = 2 To 数据行数
    
31. If Sheets("数据").Cells(i, "B") <> "" Then
    
32. sname = i - 1 & "-" & Sheets("数据").Cells(i, "B") '文件名字
    
33. 
    
34. ' Sheets("个人健康信息报告表").Cells(4, "B") = Sheets("数据").Cells(i, "B")
    
35. Sheets("个人健康信息报告表").Range("$B$4") = Sheets("数据").Cells(i, "B")
    
36. Sheets("个人健康信息报告表").Range("$D$4") = Sheets("数据").Cells(i, "C")
    
37. Sheets("个人健康信息报告表").Range("$F$4") = Sheets("数据").Cells(i, "D")
    
38. Sheets("个人健康信息报告表").Range("$H$4") = Sheets("数据").Cells(i, "E")
    
39. Sheets("个人健康信息报告表").Range("$B$5") = Sheets("数据").Cells(i, "F")
    
40. Sheets("个人健康信息报告表").Range("$D$5") = Sheets("数据").Cells(i, "G")
    
41. Sheets("个人健康信息报告表").Range("$F$5") = Sheets("数据").Cells(i, "H")
    
42. Sheets("个人健康信息报告表").Range("$B$6") = Sheets("数据").Cells(i, "I")
    
43. Sheets("个人健康信息报告表").Range("$F$6") = Sheets("数据").Cells(i, "J")
    
44. Sheets("个人健康信息报告表").Range("$B$7") = Sheets("数据").Cells(i, "K")
    
45. Sheets("个人健康信息报告表").Range("$B$8") = Sheets("数据").Cells(i, "L")
    
46. Sheets("个人健康信息报告表").Range("$B$9") = Sheets("数据").Cells(i, "M")
    
47. Sheets("个人健康信息报告表").Range("$F$9") = Sheets("数据").Cells(i, "N")
    
48. Sheets("个人健康信息报告表").Range("$B$10") = Sheets("数据").Cells(i, "O")
    
49. Sheets("个人健康信息报告表").Range("$B$11") = Sheets("数据").Cells(i, "P")
    
50. Sheets("个人健康信息报告表").Range("$B$12") = Sheets("数据").Cells(i, "Q")
    
51. Sheets("个人健康信息报告表").Range("$B$13") = Sheets("数据").Cells(i, "R")
    
52. Sheets("个人健康信息报告表").Range("$C$14") = Sheets("数据").Cells(i, "S")
    
53. Sheets("个人健康信息报告表").Range("$F$14") = Sheets("数据").Cells(i, "T")
    
54. 
    
55. 
    
56. 
    
57.         Sheets("个人健康信息报告表").Copy                                   '复制工作表到新工作簿
    
58.         ActiveWorkbook.SaveAs folder & "" & sname & ".xlsx"  '保存工作簿，并命名
    
59.         ActiveWorkbook.Close
    
60. 
    
61. End If
    
62. 
    
63. Next i
    
64. 
    
65. 
    
66. 
    
67. Sheets("个人健康信息报告表").Range("$B$4") = ""
    
68. Sheets("个人健康信息报告表").Range("$D$4") = ""
    
69. Sheets("个人健康信息报告表").Range("$F$4") = ""
    
70. Sheets("个人健康信息报告表").Range("$H$4") = ""
    
71. Sheets("个人健康信息报告表").Range("$B$5") = ""
    
72. Sheets("个人健康信息报告表").Range("$D$5") = ""
    
73. Sheets("个人健康信息报告表").Range("$F$5") = ""
    
74. Sheets("个人健康信息报告表").Range("$B$6") = ""
    
75. Sheets("个人健康信息报告表").Range("$F$6") = ""
    
76. Sheets("个人健康信息报告表").Range("$B$7") = ""
    
77. Sheets("个人健康信息报告表").Range("$B$8") = ""
    
78. Sheets("个人健康信息报告表").Range("$B$9") = ""
    
79. Sheets("个人健康信息报告表").Range("$F$9") = ""
    
80. Sheets("个人健康信息报告表").Range("$B$10") = ""
    
81. Sheets("个人健康信息报告表").Range("$B$11") = ""
    
82. Sheets("个人健康信息报告表").Range("$B$12") = ""
    
83. Sheets("个人健康信息报告表").Range("$B$13") = ""
    
84. Sheets("个人健康信息报告表").Range("$C$14") = ""
    
85. Sheets("个人健康信息报告表").Range("$F$14") = ""
    
86. 
    
87.     Application.DisplayAlerts = True
    
88.     Application.ScreenUpdating = True                           '开启屏幕更新
    
89. End Sub
    
90. 
    
91.   
    

复制代码

表格的最后一行改了一下

chxw68

这个不是高难而是超级难！

abc123281

没什么难度，初级知识

约定的童话

abc123281 发表于 2020-2-16 13:15
没什么难度，初级知识

大师一言道破天机

SCL5801

这个不是高难而是超级难！