[已解决]打印自动小计累计

guolianjd

求打印自动小计累计

花名册.rar (23.86 KB, 下载次数: 9)

2016-2-14 11:19 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

sry660

2016-2-14 12:11

1. Sub 打印设置()
   
2.     Dim arr, brr, i&, j&, Ys&, k&, n&
   
3.     Sheets(2).[c33:d34] = ""
   
4.     With Sheets(1)
   
5.         arr = .Range("a4:f" & .Cells(Rows.Count, 1).End(xlUp).Row)
   
6.         Ys = Application.RoundUp(UBound(arr) / 29, 0)
   
7.         ReDim brr(1 To 29, 1 To 6)
   
8.         For k = 1 To Ys
   
9.             For i = 29 * k - 28 To 29 * k
   
10.                 n = n + 1
    
11.                 If i <= UBound(arr) Then
    
12.                     For j = 1 To 6
    
13.                         brr(n, j) = arr(i, j)
    
14.                     Next
    
15.                 Else
    
16.                     For j = 1 To 6
    
17.                         brr(n, j) = ""
    
18.                     Next
    
19.                 End If
    
20.             Next
    
21.             With Sheets(2)
    
22.                 .[a4].Resize(29, 5) = brr
    
23.                 .[c33] = Application.Sum(Application.Index(brr, , 3))
    
24.                 .[c34] = .[c33] + .[c34]
    
25.                 .[d33] = Application.Sum(Application.Index(brr, , 4))
    
26.                 .[d34] = .[d33] + .[d34]
    
27.                 '.[a1:f34].PrintPreview
    
28.                 .[a1:f34].PrintOut
    
29.             End With
    
30.             n = 0
    
31.         Next
    
32.     End With
    
33. End Sub

复制代码

跳转到最佳答案楼层

sry660

1. Sub 打印设置()
   
2.     Dim arr, brr, i&, j&, Ys&, k&, n&
   
3.     Sheets(2).[c33:d34] = ""
   
4.     With Sheets(1)
   
5.         arr = .Range("a4:f" & .Cells(Rows.Count, 1).End(xlUp).Row)
   
6.         Ys = Application.RoundUp(UBound(arr) / 29, 0)
   
7.         ReDim brr(1 To 29, 1 To 6)
   
8.         For k = 1 To Ys
   
9.             For i = 29 * k - 28 To 29 * k
   
10.                 n = n + 1
    
11.                 If i <= UBound(arr) Then
    
12.                     For j = 1 To 6
    
13.                         brr(n, j) = arr(i, j)
    
14.                     Next
    
15.                 Else
    
16.                     For j = 1 To 6
    
17.                         brr(n, j) = ""
    
18.                     Next
    
19.                 End If
    
20.             Next
    
21.             With Sheets(2)
    
22.                 .[a4].Resize(29, 5) = brr
    
23.                 .[c33] = Application.Sum(Application.Index(brr, , 3))
    
24.                 .[c34] = .[c33] + .[c34]
    
25.                 .[d33] = Application.Sum(Application.Index(brr, , 4))
    
26.                 .[d34] = .[d33] + .[d34]
    
27.                 '.[a1:f34].PrintPreview
    
28.                 .[a1:f34].PrintOut
    
29.             End With
    
30.             n = 0
    
31.         Next
    
32.     End With
    
33. End Sub

复制代码

grf1973

1. Sub 本页合计()
   
2.     删除合计
   
3.     ActiveSheet.ResetAllPageBreaks
   
4.     s = 0: ss = 0
   
5.     r = [b65536].End(3).Row
   
6.     For i = 4 To r + 100
   
7.         s = s + Cells(i, 4): ss = ss + Cells(i, 4)
   
8.         If Cells(i, 1) > 0 And Cells(i, 1) Mod 29 = 0 Then
   
9.             Rows(i + 1).Resize(2).Insert
   
10.             Cells(i + 1, 2) = "本页合计": Cells(i + 1, 4) = s
    
11.             Cells(i + 2, 2) = "累   计": Cells(i + 2, 4) = ss
    
12.             Cells(i + 1, 1).Resize(2, 6).Font.Bold = True
    
13.             ActiveSheet.HPageBreaks.Add Before:=Cells(i + 3, 1)
    
14.             i = i + 2
    
15.             s = 0
    
16.         End If
    
17.     Next
    
18.     i = [b65536].End(3).Row
    
19.     Cells(i + 1, 2) = "本页合计": Cells(i + 1, 4) = s
    
20.     Cells(i + 2, 2) = "累   计": Cells(i + 2, 4) = ss
    
21.     Cells(i + 1, 1).Resize(2, 6).Font.Bold = True
    
22.     Cells(i + 1, 1).Resize(2, 6).Borders.LineStyle = 1
    
23. End Sub
    
24. Sub 删除合计()
    
25.     For i = [b65536].End(3).Row To 4 Step -1
    
26.         If Cells(i, 2) = "本页合计" Then Rows(i).Delete
    
27.         If Cells(i, 2) = "累   计" Then Rows(i).Delete
    
28.     Next
    
29. End Sub
    

复制代码