怎么批量打印63个班级的费用明细

3190496160

DFWZP 发表于 2022-12-22 15:05
我是说这个代码的教程，实现的方法。

你也是教师，在论坛混了十多年了，不应该再问这么低级的问题了吧

风中的我脸

练习拆表

1. Sub CreateTable()
   
2.     Dim aData, aTemp, i As Long
   
3.     Dim dMonth As Object
   
4.     Set dMonth = CreateObject("scripting.dictionary")
   
5.    
   
6. 
   
7.     If Sheets("数据").FilterMode Then Sheets("数据").ShowAllData
   
8.     aData = Range("a1").CurrentRegion
   
9.     For i = 1 To UBound(aData, 2)
   
10.         If aData(2, i) Like "*月" Then
    
11.             dMonth(aData(2, i)) = i
    
12.         End If
    
13.     Next
    
14.    
    
15.     Dim strKey As String, index As Long
    
16.     Dim aClassMonth, s As Long
    
17.     Dim dClass As Object
    
18.     Set dClass = CreateObject("scripting.dictionary")
    
19.     For i = 3 To UBound(aData) - 1
    
20.         For s = 0 To dMonth.Count - 1
    
21.             strKey = aData(i, 3) & "/" & dMonth.keys()(s)
    
22.             If Not dClass.exists(strKey) Then
    
23.                 aClassMonth = Sheets("确认签字").Range("a1").CurrentRegion
    
24.                 aClassMonth(1, 1) = VBA.Replace(aClassMonth(1, 1), "月", dMonth.keys()(s))
    
25.                 aClassMonth(2, 1) = 3
    
26.                 dClass(strKey) = aClassMonth
    
27.             End If
    
28.             aTemp = dClass(strKey)
    
29.             aTemp(2, 1) = aTemp(2, 1) + 1
    
30.             index = aTemp(2, 1)
    
31.             If index <= 36 Then
    
32.                 aTemp(index, 2) = aData(i, 2)
    
33.                 aTemp(index, 3) = aData(i, 3)
    
34.                 aTemp(index, 4) = aData(i, dMonth.items()(s))
    
35.             Else
    
36.                 index = index - 36 + 3
    
37.                 aTemp(index, 8) = aData(i, 2)
    
38.                 aTemp(index, 9) = aData(i, 3)
    
39.                 aTemp(index, 10) = aData(i, dMonth.items()(s))
    
40.             End If
    
41.             dClass(strKey) = aTemp
    
42.         Next
    
43.     Next
    
44.    
    
45.     With Application
    
46.         .ScreenUpdating = False
    
47.         .DisplayAlerts = False
    
48.         .AskToUpdateLinks = False
    
49.         .Calculation = xlCalculationManual
    
50.     End With
    
51.    
    
52.     Dim strMonth As String, p As Long
    
53.     On Error Resume Next
    
54.     For i = 0 To dMonth.Count - 1
    
55.         strMonth = dMonth.keys()(i)
    
56.         Sheets.Add(after:=Sheets(Sheets.Count)).Name = strMonth
    
57.         If Err.Number Then
    
58.             ActiveSheet.Delete
    
59.             Err.Clear
    
60.         End If
    
61.         p = 0
    
62.         For s = 0 To dClass.Count - 1
    
63.             strKey = dClass.keys()(s)
    
64.             If InStr(strKey, strMonth) Then
    
65.                 index = 1 + 37 * p
    
66.                 With Sheets(strMonth)
    
67.                     Sheets("确认签字").Range("a1").CurrentRegion.Copy
    
68.                     .Range("a" & index).PasteSpecial Paste:=xlPasteFormats
    
69.                     .Range("a" & index).Resize(UBound(aTemp), UBound(aTemp, 2)) = dClass(strKey)
    
70.                     .Range("a" & index + 1) = ""
    
71.                 End With
    
72.                 p = p + 1
    
73.             End If
    
74.         Next
    
75.         Sheets(strMonth).Range("a1").CurrentRegion.EntireColumn.AutoFit
    
76.     Next
    
77.    
    
78.     Application.CutCopyMode = False
    
79.     With Application
    
80.         .ScreenUpdating = True
    
81.         .DisplayAlerts = True
    
82.         .AskToUpdateLinks = True
    
83.         .Calculation = xlCalculationAutomatic
    
84.     End With
    
85.     MsgBox "ok"
    
86. End Sub

复制代码