根据数据源的指定条件向格式表格中写入数据并保存打印

pfcszp

要求：
1、将上述数据按照“录入日期”写入到统计表，统计表中的“申请内容”内容为：“同意支付”&付款名称&报销金额&“元，该笔款项为我行”&事由&“的费用，列支“”&科目&“”科目。”
2、将每个以日期填好的统计表另存为新的工作薄，文件名格式为：所属机构+录入日期，同时并打印统计表，打印份数默认6份。

pfcszp

麻烦老师们指点下

ykcbf1100

附件供参考。

没考虑打印的事，这个应该不难。

ykcbf1100

总表拆分

1. Sub ykcbf()   '//2024.9.12
   
2.     Dim wb, arr, sh
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Dim tm: tm = Timer
   
6.     Set fso = CreateObject("Scripting.FileSystemObject")
   
7.     Set d = CreateObject("Scripting.Dictionary")
   
8.     p = ThisWorkbook.Path & ""
   
9.     Set ws = ThisWorkbook
   
10.     Set sh = ws.Sheets("数据")
    
11.     On Error Resume Next
    
12.     arr = sh.UsedRange
    
13.     For i = 2 To UBound(arr)
    
14.         If arr(i, 1) <> Empty Then
    
15.             s = CStr(arr(i, 6))
    
16.             If Not d.exists(s) Then Set d(s) = CreateObject("Scripting.Dictionary")
    
17.             d(s)(i) = i
    
18.         End If
    
19.     Next
    
20.     For Each k In d.keys
    
21.         Sheets("统计表").Copy
    
22.         Set wb = ActiveWorkbook
    
23.         m = 0
    
24.         ReDim brr(1 To d(k).Count, 1 To UBound(arr, 2))
    
25.         With wb.Sheets(1)
    
26.             .Name = k
    
27.             .[d3] = k
    
28.             For Each kk In d(k).keys
    
29.                 m = m + 1
    
30.                 brr(m, 1) = m
    
31.                 brr(m, 2) = arr(kk, 1)
    
32.                 brr(m, 3) = arr(kk, 12)
    
33.                 brr(m, 4) = "同意支付" & arr(kk, 10) & arr(kk, 5) & "元，该笔款项为我行" & arr(kk, 2) & "的费用，列支“" & arr(kk, 11) & "”科目。"
    
34.                 jg = arr(kk, 1)
    
35.             Next
    
36.             .[a5].Resize(m, 4) = brr
    
37.         End With
    
38.         wb.SaveAs p & jg & k
    
39.         wb.Close
    
40.     Next
    
41.     Set d = Nothing
    
42.     Application.ScreenUpdating = True
    
43.     MsgBox "拆分完毕，共用时：" & Format(Timer - tm) & "秒！"
    
44. End Sub
    

复制代码