求助：EXCEL工资表用VBA代码自动生成“本页小计”，“总计”

ljxlwq_0803

yaozong 发表于 2018-10-10 07:34
参考附件。。。。。。。。。。。。。

老师您好：又要麻烦请教您了，新个税工资表，工作薄中增加了“1月工资表”、“2月工资表”、“3月工资表”……“12月工资表”，每月工资表中都想用“建立分页小计”、“删除分页小计”，这样的话，代码中的“*月工资表”要如何写？每月工资表能单独“操作”？万分感谢！

yaozong

Sheets("1月工资表").Activate
上面这句不用便是，页面显示哪个表，就运行哪个表。
''''Sheets("1月工资表").Activate

ljxlwq_0803

yaozong 发表于 2019-2-20 09:13
Sheets("1月工资表").Activate
上面这句不用便是，页面显示哪个表，就运行哪个表。
''''Sheets("1月工资 ...

收到，谢谢！！

ljxlwq_0803

yaozong 发表于 2018-10-3 11:37
插入人工分页符

Sub 插入小计合计()

老师您好：再麻烦请教，一、“1月工资表”中，X列"累计税额"我想套用ROUND保留2位小数，出现错误（如12、13行，以下行忽略），请问该如何运用公式？
二、我想在表中操作：固定1-12月工资表格，无法修改表头等（包括不能增加、移动或插入列等格式，但能增加行数），我原来用保护单元格后设置密码，但设置密码后，新增加的行，下拉公式时，公式无效，请问这个要如何解决？能通过VBA代码锁定吗？谢谢！！

yaozong

ljxlwq_0803 发表于 2019-2-20 22:16
老师您好：再麻烦请教，一、“1月工资表”中，X列"累计税额"我想套用ROUND保留2位小数，出现错误（如12、 ...

[X5]  公式
''=ROUND(IFERROR(5*MAX(0,W5*{0.6;2;4;5;6;7;9}%-{0;504;3384;6384;10584;17184;36384}),""),2)

改为：

''=IF(W5="","",ROUND(IFERROR(5*MAX(0,W5*{0.6;2;4;5;6;7;9}%-{0;504;3384;6384;10584;17184;36384}),""),2))


X6及以下可拖拽下拉。

ljxlwq_0803

yaozong 发表于 2019-2-21 09:05
[W5]  公式
''=ROUND(IFERROR(5*MAX(0,W5*{0.6;2;4;5;6;7;9}%-{0;504;3384;6384;10584;17184;36384}),"" ...

收到，太感谢了！谢谢！！

yaozong

ljxlwq_0803 发表于 2019-2-21 09:08
收到，太感谢了！谢谢！！

公式应是[X5]的单元格

ljxlwq_0803

yaozong 发表于 2019-2-21 11:10
公式应是[X5]的单元格

谢谢老师，已按您的公式改好了！

hanzhang98

各位老师您好！本人VBA菜鸟一个，在http://club.excelhome.net/thread-1124568-1-1.html[6楼]下载了“yaozong”老师的回复示例文件，套用后已成功实现了自动分页小计和总计，非常感谢。但还想实现一个功能，就是：在我的“表”里“B列”为[岗位类别]，其单元格内容分别为“管理岗、技术岗、生产工人岗、其它岗”每个岗类的人数不定，有多有少，我想要达到的效果是：（一）按“岗位类别”（B列）进行按类“分页小计”和“岗类合计”，即：增加类似“B列单元格值 + 合计”的合计行；（二）如果“岗位类别”（B列）的人数小于一页的，加入“本页小计”和“B列单元格值+合计”二行。如果“岗位类别”（B列）的人数大于一页的，在每页加入“本页小计”，在该“岗位类别”最后一页要加入“本页小计”和“B列单元格值+合计”二行，且该页不再显示B列接下来的另一类“岗位类别”的人员，即将B列接下来的另一类“岗位类别”的人员推到下一页再显示；（三）在最后一个“岗位类别”人员的最后一页，在其已加入“本页小计”和“B列单元格值+合计”二行的基础上再加入所有人员的“总计”行。请各位老师帮助添加修改代码。谢谢！
       想要达到的效果已经做好了个附件文件，相供老师们直接参考并添加修改代码。但论坛里无论如何也上传不了附件http://club.excelhome.net/thread-1464618-1-1.html（在附件里有“想达到的效果”工作表），实在无奈，恳请老师们原谅。
“yaozong”老师的原代码如下：
Dim rCurrentCell As Range   ' 每一页之分页小计所在单元格
Dim r1stSubCell As Range    ' 小计区域第一个单元格
' -------------------------------------------------
' 从这里开始执行
Sub Main()
    t = Timer
    Application.ScreenUpdating = False         '关闭屏幕刷新
    Worksheets("sheet1").Activate              '激活工作表“sheet1”
    删除分页符
    Set r1stSubCell = Range("A5")           ' 本例名单从 A5 单元格开始

    For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
        If rCurrentCell = "本页小计" Or rCurrentCell = "总  计" Then rCurrentCell.EntireRow.Delete
    Next
    Set r1stSubCell = Range("A5")           ' 本例名单从 A5 单元格开始
    For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
        If rCurrentCell = "本页小计" Or rCurrentCell = "总  计" Then rCurrentCell.EntireRow.Delete
    Next

    新建分页小计
    Range("A5").Activate

    MsgBox "分页小计已完成!" & Chr(13) & "共用时间" & Round(Timer - t, 2) & "秒"
    Application.ScreenUpdating = True         '开启屏幕刷新
End Sub
' -------------------------------------------------
Sub 删除原有的分页小计行()
    Application.ScreenUpdating = False         '关闭屏幕刷新
    Set r1stSubCell = Range("A5")              '本例名单从 A5 单元格开始
    For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
        If rCurrentCell = "本页小计" Or rCurrentCell = "总  计" Then rCurrentCell.EntireRow.Delete
    Next
    Set r1stSubCell = Range("A5")           ' 本例名单从 A5 单元格开始
    For Each rCurrentCell In Range(r1stSubCell, r1stSubCell.End(xlDown))
        If rCurrentCell = "本页小计" Or rCurrentCell = "总  计" Then rCurrentCell.EntireRow.Delete
    Next

    Range("A1").Activate
    MsgBox "已成功删除分页小计"
    Application.ScreenUpdating = True         '开启屏幕刷新
End Sub
Sub 新建分页小计()
    Dim iSubCol As Integer, rSubArea As Range
    Dim hb As HPageBreak

    Worksheets("sheet1").Activate              '激活工作表“sheet1”
    Rows(Range("a65536").End(xlUp).Row).Copy Range("a" & Range("a65536").End(xlUp).Row + 1)
    Rows(Range("a65536").End(xlUp).Row).ClearContents
    Range("a" & Range("a65536").End(xlUp).Row + 1) = " "
    ActiveWindow.View = xlPageBreakPreview  ' 进入 分页浏览 模式, 以便 EXCEL 正确计页
    Set r1stSubCell = Range("A5")           ' 本例名单从 A5 单元格开始
    iSubCol = 9                             ' 本例小计项共有 21 列

    ' 最后一行插入手工分页符
    ActiveSheet.HPageBreaks.Add Before:=r1stSubCell.End(xlDown).Offset(1, 0)
    ActiveSheet.HPageBreaks.Add Before:=Range("a65536").End(xlUp)

    ' 测试每一个分页符,
    ' 如果是自动分页符, 则在其上一行插入一小计行, 而本行纳入下一页
    ' 否则, 在本行插入一小计行
    For Each hb In ActiveSheet.HPageBreaks
        Set rCurrentCell = hb.Location
        rCurrentCell.Select                 ' 看看先

        If hb.Type = xlPageBreakAutomatic Then Set rCurrentCell = rCurrentCell.Offset(-1, 0)

        rCurrentCell.EntireRow.Insert
        Set rCurrentCell = rCurrentCell.Offset(-1, 0)

        ' 添加分页小计内容
        With rCurrentCell
            .Value = "本页小计"
            .Font.Bold = True

            'Set rSubArea = Application.Union(Range("d" & rCurrentCell.Row), Range("V" & rCurrentCell.Row))  ' 需要填充分页小计公式的区域V列

            'Set rSubArea = Range("b" & rCurrentCell.Row, "V" & rCurrentCell.Row)  ' 需要填充分页小计公式的区域V列''B至V列的区域（共21列）
            r = rCurrentCell.Row
            Set rSubArea = Union(Range("d" & r), Range("f" & r), Range("j" & r), Range("m" & r)) ''填充分页小计公式的区域仅是其中3列（f、i、j)

            ' 使用 SUBTOTAL 公式的好处是方便扩展, 且不会对已计算区域重复计算(如果可能发生这种情况的话)
            rSubArea.Formula = "=SUBTOTAL(9," & r1stSubCell.Offset(0, 5).Address(1, 0) & ":" & .Offset(-1, 5).Address(1, 0) & ")"
            Set r1stSubCell = .Offset(1, 0)
        End With
    Next
    Rows(Range("a65536").End(xlUp).Row).Clear

    If Range("A65536").End(xlUp) = " " Then Rows(Range("a65536").End(xlUp).Row).Clear

    Rows(Range("a65536").End(xlUp).Row).Copy Range("a" & Range("a65536").End(xlUp).Row + 1)
    Rows(Range("a65536").End(xlUp).Row).ClearContents

    With Range("A" & Range("A65536").End(xlUp).Row + 1)
        .Value = "总  计"
        .Font.Bold = True
    End With
    'Set rSubArea = Range("b" & Range("A65536").End(xlUp).Row, "V" & Range("A65536").End(xlUp).Row) 'V列
    r = Range("A65536").End(xlUp).Row
    Set rSubArea = Union(Range("d" & r), Range("f" & r), Range("j" & r), Range("m" & r)) ''其中3列（f\i\j)
    rSubArea.Offset(0, 0) = "=SUBTOTAL(9," & "f5:f" & Range("A65536").End(xlUp).Row - 1 & ")"
    删除分页符
    ActiveWindow.View = xlNormalView
End Sub
Sub 删除分页符()
On Error Resume Next
    t = ActiveSheet.HPageBreaks.Count
    For n = t To 1 Step -1
        If ActiveSheet.HPageBreaks(n).Extent = xlPageBreakFull Then
            ActiveSheet.HPageBreaks(n).Delete
        End If
        t = ActiveSheet.HPageBreaks.Count
    Next
End Sub

syzengpeng

又学习到了不少的东西，谢谢