[已解决]求助EXCEL用VBA分页并插入本页一列数值小计和该列数值总合计以及相同的表尾

石来运转6888

最佳答案

月排行榜 / 总排行榜

scl5801

2015-6-27 18:38

石来运转6888 发表于 2015-6-27 14:28
请大侠写一个

Sub 分页()
    With Application
       .ScreenUpdating = False
        ActiveSheet.ResetAllPageBreaks
       .Calculation = xlCalculationManual
        Dim ysb As Worksheet
        Set ysb = Worksheets("原始表")
        Dim i As Integer, arr
        Dim b%, c%, r_end%, n%
        .Range("a4:k28").ClearContents
        Range("b2").FormulaR1C1 = " 工 资  表"
        Range("a25").FormulaR1C1 = "单位名称：广州市启新有限公司:"
        Range("a26").FormulaR1C1 = "地址:广州市白云区:"
        Range("a28").FormulaR1C1 = "制表人:            复核人:           签发人:"
        .Range("a29:k" & Rows.Count).Clear
        .Range("a24") = "应发合计（k列）": Range("f24") = "本页小计（k列）"
        r_end = ysb.Cells(Rows.Count, 1).End(xlUp).Row
        arr = ysb.Range("a4:k" & r_end)
        If r_end > 20 Then
           .Range("a1:k28").Copy
           b = (r_end) / 20
           If b = Int(b) Then v = Int(b) - 1 Else v = Int(b)
           For n = 1 To v
              c = n * 28 + 1
             .Range("a" & c).Select
              ActiveSheet.Paste
              ActiveSheet.HPageBreaks.Add Before:=Rows(1 + n * 28)
           Next n
        End If
        For i = 1 To r_end - 3
           n = Fix((i - 1) / 20)
           For l = 1 To 11
              Cells(i + 3 + 8 * n, l) = arr(i, l)
           Next l
           x = x + arr(i, 11)
           y = y + arr(i, 11)
           Range("i" & 24 + 28 * n) = x
           If i Mod 20 = 0 Then
             Range("i" & 24 + 28 * n) = x
             x = 0
           End If
        Next i
        Range("d" & 24 + 28 * n) = y
        .ScreenUpdating = True
         Range("l1").Select
    End With
End Sub

看看行不

跳转到最佳答案楼层

石来运转6888

请大侠写一个

石来运转6888

请大侠写一个

scl5801

石来运转6888 发表于 2015-6-27 14:28
请大侠写一个

Sub 分页()
    With Application
       .ScreenUpdating = False
        ActiveSheet.ResetAllPageBreaks
       .Calculation = xlCalculationManual
        Dim ysb As Worksheet
        Set ysb = Worksheets("原始表")
        Dim i As Integer, arr
        Dim b%, c%, r_end%, n%
        .Range("a4:k28").ClearContents
        Range("b2").FormulaR1C1 = " 工 资  表"
        Range("a25").FormulaR1C1 = "单位名称：广州市启新有限公司:"
        Range("a26").FormulaR1C1 = "地址:广州市白云区:"
        Range("a28").FormulaR1C1 = "制表人:            复核人:           签发人:"
        .Range("a29:k" & Rows.Count).Clear
        .Range("a24") = "应发合计（k列）": Range("f24") = "本页小计（k列）"
        r_end = ysb.Cells(Rows.Count, 1).End(xlUp).Row
        arr = ysb.Range("a4:k" & r_end)
        If r_end > 20 Then
           .Range("a1:k28").Copy
           b = (r_end) / 20
           If b = Int(b) Then v = Int(b) - 1 Else v = Int(b)
           For n = 1 To v
              c = n * 28 + 1
             .Range("a" & c).Select
              ActiveSheet.Paste
              ActiveSheet.HPageBreaks.Add Before:=Rows(1 + n * 28)
           Next n
        End If
        For i = 1 To r_end - 3
           n = Fix((i - 1) / 20)
           For l = 1 To 11
              Cells(i + 3 + 8 * n, l) = arr(i, l)
           Next l
           x = x + arr(i, 11)
           y = y + arr(i, 11)
           Range("i" & 24 + 28 * n) = x
           If i Mod 20 = 0 Then
             Range("i" & 24 + 28 * n) = x
             x = 0
           End If
        Next i
        Range("d" & 24 + 28 * n) = y
        .ScreenUpdating = True
         Range("l1").Select
    End With
End Sub

看看行不

石来运转6888

谢谢，学习中，每页D列没有汇总合计，最后一页出错，再一次感谢。

石来运转6888

最后一页只有3、4行数据时就不生成表了，另外可不可以每页行数不固定，行比较宽的话行数就自动少些

scl5801

没有规律那个就不好弄了，

scl5801

石来运转6888 发表于 2015-6-27 23:11
最后一页只有3、4行数据时就不生成表了，另外可不可以每页行数不固定，行比较宽的话行数就自动少些

修了一下，有一行也能成表