返回列表 上一主題 發帖

加總問題

加總問題

各位大大~

不好意思我想請問一下

如下圖~有多個sheet

每個sheet的資料量不同

格式都一樣

我想在每個sheet的金額欄加總

因為sheet很多~要花一些時間~

不知道有沒有巨集是可以按一下就加總完外加把格式弄好(上底線+下雙底線)?

設一個按鈕
  1. Sub 加總()

  2. Dim sh As String '宣告為字串型態
  3. sh = ActiveWorkbook.Sheets.Count '偵測活頁部內的工作表數量
  4. For i = 1 To sh '從第一個做到最後一個工作頁
  5. Sheets(i).Select
  6.     s = [A65536].End(xlUp).Row '偵測A欄最後一列數字
  7.     '加總
  8.     Cells(s + 1, 4).Value = Application.WorksheetFunction.Sum(Range(Cells(1, 4), Cells(s, 4)))
  9.     Cells(s + 1, 4).Select
  10.         '上底線加下雙底線
  11.     Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
  12.     Selection.Borders(xlEdgeBottom).LineStyle = xlDouble
  13.      
  14. Next i
  15. End Sub
複製代碼
指定巨集  搞定

TOP

回復 1# sky00264

設一個按鈕
  1. Sub 加總()

  2. Dim sh As String '宣告為字串型態
  3. sh = ActiveWorkbook.Sheets.Count '偵測活頁部內的工作表數量
  4. For i = 1 To sh '從第一個做到最後一個工作頁
  5. Sheets(i).Select
  6.     s = [A65536].End(xlUp).Row '偵測A欄最後一列數字
  7.     '加總
  8.     Cells(s + 1, 4).Value = Application.WorksheetFunction.Sum(Range(Cells(1, 4), Cells(s, 4)))
  9.     Cells(s + 1, 4).Select
  10.         '上底線加下雙底線
  11.     Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
  12.     Selection.Borders(xlEdgeBottom).LineStyle = xlDouble
  13.      
  14. Next i
  15. End Sub
複製代碼
指定巨集
按下按鈕 搞定!

TOP

感謝大大~晚點來試試看^^

TOP

那我想在問一下大大~
s = [A65536].End(xlUp).Row ~是偵測A欄最後一列數字
假設我今天要偵測B欄共有幾列的話~
要怎麼寫呢?

TOP

本帖最後由 Hsieh 於 2012-11-30 08:30 編輯

回復 1# sky00264


   使用立體參照公式即可計算
play.gif
學海無涯_不恥下問

TOP

回復 3# die78325

我想要在問一下~
大大幫我寫的巨集在結果上會直接顯示加總數字
但如果我今天要讓加總欄顯示sum的公式的話這樣做得到嗎?

TOP

本帖最後由 kimbal 於 2012-12-1 09:00 編輯

回復 7# sky00264
借DIE兄的來改一下
  1. Sub 加總()

  2. Dim ws As Worksheet
  3.     For Each ws In ThisWorkbook.Sheets '從第一個做到最後一個工作頁
  4.         With ws.[A65536].End(xlUp).Offset(1, 3)
  5.             '3是第3行開始加總的意思
  6.             '[A65536].End(xlUp).Row 偵測A欄最後一列數字, B欄的話是 [B65536]....
  7.            .Formula = "=Sum(" & Range(Cells(3, 4), Cells(ws.[A65536].End(xlUp).Row, 4)).Address & ")"
  8.             '上底線加下雙底線
  9.             .Borders(xlEdgeTop).LineStyle = xlContinuous
  10.             .Borders(xlEdgeBottom).LineStyle = xlDouble
  11.         End With
  12.     Next
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

回復 5# sky00264


    s = [A65536].End(xlUp).Row     從A65536往上找 先碰到的位置
紅色部分   要B欄就改為B65536     
如果B欄都有數值  中間都沒有空格的劃  也可以使用  s =  [B1].End(xldown).Row        意思是 從B1往下找
s都可以自行變化    可以定義為你比較能辨識的代號
自用車也可以簽帳喔!
五千元加油金加入油箱後還回饋您6200元
福利旺車友會power-want.com

TOP

回復 8# kimbal


K大~
我複製了您寫的巨集後~
按了都沒反應@@~
不知道是不是我這邊哪個環節出了問題>"<

TOP

        靜思自在 : 道德是提昇自我的明燈,不該是呵斥別人的鞭子。
返回列表 上一主題