新人求助大神，如何自动生成报告的内容

边缘码农

加一个辅助列“是否生成”，代码运行时先检查该列的内容，当是“已生成”的，跳过。

excel玉米

边缘码农 发表于 2024-7-29 10:55
加一个辅助列“是否生成”，代码运行时先检查该列的内容，当是“已生成”的，跳过。

这位兄弟的办法可行。

睿智的元元

excel玉米 发表于 2024-7-29 11:48
这位兄弟的办法可行。

完了，具体的我不会呀。大神能帮我完善一下吗？

边缘码农

边缘码农

完整代码审核中。

边缘码农

1. Sub 生成报告()
   
2. Dim arr, i%, j%, s%
   
3. Dim sh As Worksheet, nsh As Worksheet
   
4. Dim wb As Workbook, wbname As String
   
5. Application.ScreenUpdating = False
   
6. arr = Sheets("清单").UsedRange
   
7. For i = 2 To UBound(arr)
   
8.     If arr(i, 21) = "" Then
   
9.         If Len(arr(i, 1)) > 0 Then
   
10.            For j = 12 To 16 Step 2
    
11.               wbname = arr(1, j) & " " & arr(i, 2) & " " & arr(i, 3) & " " & arr(i, 4) & " " & arr(i, 7)
    
12.               If Dir(ThisWorkbook.Path & "" & wbname & ".xls") <> "" Then
    
13.                  MsgBox "您已生成过报告单", vbOKOnly, "ExcelHOME"
    
14.                  MsgBox "即将退出程序,请检查ok后再运行", vbOKOnly, "ExcelHOME"
    
15.                  Exit Sub
    
16.               End If
    
17.               If Len(arr(i, j)) > 0 Then
    
18.                  Set sh = Sheets(arr(1, j))
    
19.                  With sh
    
20.                    If .Name = "金相" Then
    
21.                       For s = 4 To 6
    
22.                         .Cells(s, 2) = "" '清除原模板数据
    
23.                         .Cells(s, 6) = ""
    
24.                       Next s
    
25.                    ElseIf .Name = "冲击" Then
    
26.                       For s = 4 To 6
    
27.                         .Cells(s, 3) = ""  '清除原模板数据
    
28.                         .Cells(s, 10) = ""
    
29.                       Next s
    
30.                    ElseIf .Name = "硬度" Then
    
31.                       For s = 4 To 6
    
32.                         .Cells(s, 3) = ""  '清除原模板数据
    
33.                         .Cells(s, 9) = ""
    
34.                       Next s
    
35.                    End If
    
36.                  End With
    
37.                  Sheets(sh.Name).Copy after:=Sheets(Sheets.Count)
    
38.                  Set nsh = Sheets(Sheets.Count)
    
39.                  With nsh
    
40.                    If sh.Name = "金相" Then
    
41.                       .Cells(4, 2) = arr(i, 6) '"规格"
    
42.                       .Cells(5, 2) = arr(i, 5) '"炉号"
    
43.                       .Cells(6, 2) = arr(i, 7) '"材质"
    
44.                       .Cells(4, 6) = arr(i, 3) '"样品编号"
    
45.                       .Cells(5, 6) = arr(i, 4) '"批号"
    
46.                       .Cells(6, 6) = arr(i, 2) '"送检单位"
    
47.                    ElseIf sh.Name = "冲击" Then
    
48.                       .Cells(4, 3) = arr(i, 4) '"批号"
    
49.                       .Cells(5, 3) = arr(i, 5) '"炉号"
    
50.                       .Cells(6, 3) = arr(i, 6) '"规格"
    
51.                       .Cells(4, 10) = arr(i, 7) '"材质"
    
52.                       .Cells(5, 10) = arr(i, 2) '"送检单位"
    
53.                       .Cells(6, 10) = arr(i, 3) '"样品编号"
    
54.                    ElseIf sh.Name = "硬度" Then
    
55.                       .Cells(4, 3) = arr(i, 4) '"批号"
    
56.                       .Cells(5, 3) = arr(i, 5) '"炉号"
    
57.                       .Cells(6, 3) = arr(i, 6) '"规格"
    
58.                       .Cells(4, 9) = arr(i, 7) '"材质"
    
59.                       .Cells(5, 9) = arr(i, 2) '"送检单位"
    
60.                       .Cells(6, 9) = arr(i, 3) '"样品编号"
    
61.                    End If
    
62.                    Set wb = Workbooks.Add
    
63.                    .Copy after:=wb.Sheets(1)
    
64.                    wb.SaveAs ThisWorkbook.Path & "" & wbname & ".xls"
    
65.                    wb.Close
    
66.                    Application.DisplayAlerts = False
    
67.                      .Delete
    
68.                    Application.DisplayAlerts = True
    
69.                  End With
    
70.               End If
    
71.            Next j
    
72.            Sheets("清单").Cells(i, 21) = "已生成"
    
73.         End If
    
74.     End If
    
75. Next i
    
76. MsgBox "生成报告单工作完成", vbOKOnly, "ExcelHOME"
    
77. Worksheets("清单").Activate
    
78. Application.ScreenUpdating = False
    
79. End Sub
    

复制代码

睿智的元元

边缘码农 发表于 2024-7-29 10:55
加一个辅助列“是否生成”，代码运行时先检查该列的内容，当是“已生成”的，跳过。

这位大神可以帮我完善一下吗？

睿智的元元

边缘码农 发表于 2024-7-29 14:52

大神，我复制后已经可以了。 但是保存在桌面上了，能否让其保存在相应的文件夹内

边缘码农

睿智的元元 发表于 2024-7-29 15:47
大神，我复制后已经可以了。 但是保存在桌面上了，能否让其保存在相应的文件夹内

现在保存的文件，和清单这个工作簿在一个文件夹内。

不要直接将工作簿放在桌面上。可以在桌面上新建一个文件夹，将清单这个工作簿复制到新建的文件夹内。

试试。

睿智的元元

边缘码农 发表于 2024-7-29 16:26
现在保存的文件，和清单这个工作簿在一个文件夹内。

不要直接将工作簿放在桌面上。可以在桌面上新建一 ...

保存在桌面的新建文件夹了，还是默认保存在桌面，而且前面也多了一个“新建文件夹”的名称