自动插入“合计”行并汇总计算

imlzrlzr

你们好，请高手们，我有几张表，表的格式 是一样的（请看附件），1、如何 用 代码设计一个按钮，实现在表中的第一空白行插入“合计”行并自动汇总计算（I和L列），2、另外也设计 一个按钮。当不要“合计行”时能实现撤销“合计”行。

LangQueS

关于管理数据的基本方法请参考：
  
★Excel数据管理的一般规律★    http://club.excelhome.net/thread-287461-1-1.html

imlzrlzr

LangQueS 发表于 2012-8-4 22:55
关于管理数据的基本方法请参考：
  
★Excel数据管理的一般规律★    http://club.excelhome.net/thread- ...

看不懂的。我是菜鸟来的，你能帮我吗

LangQueS

请参考下帖中数据表的样式，设置好能使用透视表汇总的数据表……

★数据透视表中使用组合★        http://club.excelhome.net/thread-307220-1-1.html

LangQueS

设置数据表要注意的几个基本原则：
  1、管理数据要设置多个工作表，例如、表单、数据表(称作“数据库”)、引用表、筛选表、信息表、汇总报表、其他辅助(例如目录表)表等等，不可混淆。其中数据表专用来保存日常发生的数据。
  2、将日常发生的数据保存在同一个工作表(“数据库”)中。如果数据源在多个工作簿或工作表中，首先要合并数据。
  3、数据表是一维表，第一个字段是“行号”字段，“行号”字段各行内容由公式"=ROW()"形成
  4、数据库表的标题行是1行，没有重复名称，字段名称之间不间隔空单元。
  5、数据库表中除了“行号”字段，其他位置无公式设置。
  6、数据库表中不设置复杂的格式，例如合并单元格、数据有效性等等。
  7、日常发生的每个“事件”对应数据库表中的标题名称记录在数据库表的一行中。
设置好基础数据表，非常有利于以后的数据管理；而用报表形式保存数据是不正确的，会给以后的数据管理和使用造成很大困难。

imlzrlzr

LangQueS 发表于 2012-8-4 23:21
设置数据表要注意的几个基本原则：
  1、管理数据要设置多个工作表，例如、表单、数据表(称作“数据库”)、 ...

谢谢了！明白了！

YEJINHAI

imlzrlzr 发表于 2012-8-5 00:48
谢谢了！明白了！

参考一下里面的代码。

Sub 插入每页小计累计()
Dim x$, r, a, b, k, m, n, i, j
If MsgBox("你确定要插入本页合计&本页累计吗？", vbYesNo, "★ ★ ★ ★ 王德荣提示 ★ ★ ★ ★") = vbYesNo Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    a = 3 '顶端标题行行数
    k = ActiveWindow.SelectedSheets.HPageBreaks(1).Location.Row - a - 3 '[减3：小计行+累计行+1(常数)]
   
    r = [a65536].End(3).Row
    b = (r - a) Mod k
    If b > 0 Then n = k - (r - a) Mod k Else n = 0
    For i = r + n To a + k - 1 Step -k
        Cells(i, 1).Offset(1, 0).Resize(2, 1).EntireRow.Insert
        Cells(i + 1, 1) = "本页合计": Cells(i + 2, 1) = "本页累计"
        Cells(i + 1, 1).Resize(1, 33).Interior.ColorIndex = 36
        Cells(i + 2, 1).Resize(1, 33).Interior.ColorIndex = 34
        For j = 2 To 33
            Cells(i + 2, j) = WorksheetFunction.Sum(Range(Cells(3, j), Cells(i, j)))
            Cells(i + 1, j) = WorksheetFunction.Sum(Range(Cells(i - k + 1, j), Cells(i, j)))
        Next
    Next
    r = [a65536].End(3).Row
    Cells(r - n - 1, 1).Resize(n + 2, 33).Borders.LineStyle = 1
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

YEJINHAI

YEJINHAI 发表于 2012-8-5 02:15
参考一下里面的代码。

Sub 插入每页小计累计()

Sub 删除每页小计累计()
'Dim r&
'If MsgBox("你确定要删除插入本页合计&本页累计吗？", vbYesNo, "★ ★ ★ ★ 王德荣提示 ★ ★ ★ ★") = vbYesNo Then Exit Sub
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
    'r = [A65536].End(3).Row
   ' Range("A4:A" & r).SpecialCells(4).Delete (3)
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
If MsgBox("你确定要插入本月合计&本年累计吗？", vbYesNo, "★ ★ ★ ★ 王德荣提示 ★ ★ ★ ★") = vbYesNo Then Exit Sub
On Error Resume Next
[A:A].Replace "*计", "#N/A", 1
[A:A].SpecialCells(2, 16).Delete (3)
End Sub

YEJINHAI

YEJINHAI 发表于 2012-8-5 02:16
Sub 删除每页小计累计()
'Dim r&
'If MsgBox("你确定要删除插入本页合计&本页累计吗？", vbYesNo, "★  ...

Sub 插入年度小计累计()
    Dim arr, brr(), l&, i&, m&, t, r&
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error Resume Next
    [A:A].Replace "*计", "#N/A", 1
    [A:A].SpecialCells(2, 16).Delete (3)
    On Error GoTo 0
    r = [a65536].End(3).Row
    Range("A4:AG" & r).Sort Key1:=Range("A4"), Order1:=xlAscending
    arr = Range("A1:A" & r)
    ReDim brr(1 To UBound(arr))
    For i = 4 To UBound(arr)
        If Month(arr(i, 1)) <> t Then
            m = m + 1
            brr(m) = i
            t = Month(arr(i, 1))
        End If
    Next
    m = m + 1
    brr(m) = i
    With WorksheetFunction
        For l = m To 2 Step -1
            i = brr(l)
            Rows(i).Insert
            Cells(i, 1) = "本月合计"
            Cells(i, 1).Resize(1, 33).Interior.ColorIndex = 36
            Cells(i, 2).Resize(1, 32) = "=SUM(R" & brr(l - 1) & "C:R" & i - 1 & "C)"
            i = i + 1
            Rows(i).Insert
            Cells(i, 1) = "本年累计"
            Cells(i, 1).Resize(1, 33).Interior.ColorIndex = 34
            Cells(i, 2).Resize(1, 32) = "=SUMIF(R4C1:R" & i & "C1,""*合计"",R4C:R" & i & "C)"
        Next
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

YEJINHAI

这些都是人家现成的代码，挺好的，修改里面的参数就可以。