加载中…
个人资料
  • 博客等级:
  • 博客积分:
  • 博客访问:
  • 关注人气:
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
正文 字体大小:

EXCEL VBA 小计合计自动计算可达到分类汇总的效果

(2012-12-27 15:18:37)
标签:

excelvba小计合计自动

杂谈

分类: 电脑测量*编程技术

假设表格名为 "汇总" 和"小计汇总",此表格为51列,您可根据需要修改

Private Sub 小计合计计算2012() '''2012年12月21日

Dim r&, i&, j%, n&
Dim heji(5 To 51) As Double
Application.ScreenUpdating = False
Sheets("小计汇总").Cells.Borders.LineStyle = 0 '实线   xlSingle---虚线  xlDouble--

Sheets("汇总").Select
r = Sheets("汇总").UsedRange.Rows.Count '把表格Sheet1中用户已经使用过的行数赋给常量n
Debug.Print r
  For i = 5 To r - 1
     Debug.Print i
      ''''''下面  RC[-1] 则为所在列的左边1列、以此类推,列公式可以据此编辑
      Cells(i, 26).FormulaR1C1 = "=SUM(RC[-20]:RC[-14]) SUM(RC[-12]:RC[-4])-RC[-3]-RC[-2]-RC[-1]"
      Cells(i, 36).FormulaR1C1 = "=SUM(RC[-9]:RC[-1])"
      Cells(i, 37).FormulaR1C1 = "=RC[-11] - RC[-1]"
        Cells(i, 49).FormulaR1C1 = "=SUM(RC[-11]:RC[-1])"

        Cells(i, 50).FormulaR1C1 = "=ROUND(RC[-24] RC[-1],2)"
        Cells(i, 51).FormulaR1C1 = "=ROUND(RC[-14] RC[-2],2)"
  
  Next
  ''''''''''计算小计
n = 4 '''''''''''''''''''''''为姓名所在行12-22
  For i = 5 To r - 1
   If Cells(i, 1) = "小计" Then
        m = Cells(i, 1).Row
        Debug.Print m, n '''17

         For j = 5 To 52
        
               Debug.Print "=SUBTOTAL(9,R[-" & m - n - 1 & "]C:R[-1]C)"
               Cells(i, j).FormulaR1C1 = "=SUBTOTAL(9,R[-" & m - n - 1 & "]C:R[-1]C)"
         Next
          n = m
    End If
  
  Next
    ''''''''''计算小计
    r = Sheets("汇总").UsedRange.Rows.Count '把表格Sheet1中用户已经使用过的行数赋给常量n

  ''''''''''计算合计12-22
         For j = 5 To 52
             Cells(r, j).FormulaR1C1 = "=SUBTOTAL(9,R[-" & r - 3 & "]C:R[-1]C)"

         Next
  ''''''''''计算合计

     
Debug.Print "小计合计计算完毕!"

r = Sheets("汇总").UsedRange.Rows.Count '把表格Sheet1中用户已经使用过的行数赋给常量n
Sheets("汇总").UsedRange.Rows(r).NumberFormatLocal = "0.00_ "

''''''汇总表至小计汇总表
n = 5
  For i = 5 To r - 1
  Debug.Print i
    If Sheets("汇总").Cells(i, 1) = "小计" Then
           Sheets("小计汇总").Rows(n).Value = Sheets("汇总").Rows(i).Value '将一个表中的一行全部拷贝到另一个表中
             n = n 1
   End If
  Next
  Sheets("小计汇总").Rows(n).Value = Sheets("汇总").Rows(r).Value '将一个表中的一行全部拷贝到另一个表中

For i = 5 To n - 1 '''序号
Sheets("小计汇总").Cells(i, 1) = i - 4
Next
''''''汇总表至小计汇总表
Sheets("小计汇总").Range("A3").Resize(n - 2, 52).Borders.LineStyle = 1 '实线   xlSingle---虚线  xlDouble---双线 2012-12-23

MsgBox "小计合计计算完毕!"
Application.ScreenUpdating = True
End Sub

念佛一声   罪灭沙河

礼佛一拜   增福无量

敬请常念:

南无阿弥陀佛         南无阿弥陀佛         南无阿弥陀佛
南无观世音菩萨       南无观世音菩萨       南无观世音菩萨

南无大愿地藏王菩萨   南无大愿地藏王菩萨   南无大愿地藏王菩萨

0

阅读 收藏 喜欢 打印举报/Report
  

新浪BLOG意见反馈留言板 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑

新浪公司 版权所有