Board logo

標題: [發問] VBA自動加總 [打印本頁]
作者: popomilk    時間: 2016-8-4 15:56     標題: VBA自動加總

小計部分電腦產出的都沒有加總公式
想試著用巨集用相對位置模擬寫程式
但得出來的都是這種
  ActiveCell.FormulaR1C1 = "=SUM(R[-7]C:RC)"
好像沒辦法用

請問有前輩能教學嗎
感謝
作者: Joforn    時間: 2016-8-5 13:00

  1. Sub Test()
  2.   Dim I           As Long
  3.   Dim EndRow      As Long
  4.   Dim Ranges      As Range
  5.   Dim Range1      As Range
  6.   Dim strFormula  As String
  7.   
  8.   EndRow = Range("A" & Rows.Count).End(xlUp).Row
  9.   For I = 1 To EndRow
  10.     With Range("A" & I)
  11.       Select Case Trim$(.Value)
  12.         Case "小計"
  13.           .Offset(0, 1).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
  14.           If Ranges Is Nothing Then
  15.             Set Ranges = .Offset(0, 1)
  16.           Else
  17.             Set Ranges = Union(Ranges, .Offset(0, 1))
  18.           End If
  19.         Case "總計"
  20.           If Not Ranges Is Nothing Then
  21.             strFormula = vbNullString
  22.             For Each Range1 In Ranges
  23.               With Range1
  24.                 If Len(strFormula) Then
  25.                   strFormula = strFormula & "," & .Address
  26.                 Else
  27.                   strFormula = .Address
  28.                 End If
  29.               End With
  30.             Next Range1
  31.             Set Ranges = Nothing
  32.             .Offset(0, 1).Formula = "=SUM(" & strFormula & ")"
  33.           End If
  34.       End Select
  35.     End With
  36.   Next
  37. End Sub
複製代碼
作者: popomilk    時間: 2016-8-5 13:41

回復 2# Joforn


  Joforn實在太神了
請容許我在學習之前 讓我先膜拜您
非常感謝
作者: popomilk    時間: 2016-8-5 13:47

回復 2# Joforn


大師請問如果
每個項目的數量不固定的話
要怎麼修改程式碼呢

感謝!!
作者: popomilk    時間: 2016-8-5 14:17

回復 4# popomilk

有辦法自動寫入偵測該項目要加總數量有幾個的方法嗎??
而不是
資產編號一開頭項目有兩個=SUM(R[-2]C:R[-1]C)"
資產編號二開頭項目有五個=SUM(R[-5]C:R[-1]C)
資產編號三開頭項目有三個=SUM(R[-3]C:R[-1]C)""

非常感謝
作者: 准提部林    時間: 2016-8-5 14:33

  1. Sub Macro1()
  2. Dim xR As Range, N&
  3. For Each xR In Range([A2], [A65536].End(3))
  4.     If Trim(xR) = "小計" Then
  5.        If N > 0 Then xR(1, 2) = "=SUM(" & Range(xR(0, 2), xR(1 - N, 2)).Address & ")": N = 0
  6.        If N = 0 Then GoTo 101
  7.     End If
  8.     N = N + 1
  9.     If Trim(xR) = "總計" Then xR(1, 2) = "=SUMIF(R1C[-1]:R[-1]C[-1],""*小計*"",R1C:R[-1]C)"
  10. 101: Next
  11. End Sub
複製代碼
  1. Sub Macro2()
  2. Dim xR As Range, N&
  3. For Each xR In Range([A2], [A65536].End(3))
  4.     If Trim(xR) = "小計" Then xR(1, 2) = _
  5.         "=SUM(R1C:R[-1]C)-SUMIF(R1C[-1]:R[-1]C[-1],""*小計*"",R1C:R[-1]C)*2"
  6.     If Trim(xR) = "總計" Then xR(1, 2) = "=SUMIF(R1C[-1]:R[-1]C[-1],""*小計*"",R1C:R[-1]C)"
  7. Next
  8. End Sub
複製代碼
兩種方法!!!
作者: 准提部林    時間: 2016-8-5 14:34

方法二的公式:
小計:=SUM(B$1:B4)-SUMIF(A$1:A4,"*小計*",B$1:B4)*2
總計:=SUMIF(A$1:A21,"*小計*",B$1:B21)
作者: popomilk    時間: 2016-8-5 22:06

回復 6# 准提部林

版主太神拉，神手
但我實力太弱，有些看不懂，向您請教
1.
For each xR In Range([A2], [A65536].End(3))
請問那個Range([A2]], [A65536].End(3))是什麼意思呢??
我知道[A65536].End(3)是A欄從最下面上來第一個非空白的儲存格

2.
   If Trim(xR) = "小計" Then
   If N > 0 Then xR(1, 2) = "=SUM(" & Range(xR(0, 2), xR(1 - N, 2)).Address & ")": N = 0
  
請問xr(1,2)是什麼意思??

  非常感謝!!
作者: 准提部林    時間: 2016-8-6 09:53

回復 8# popomilk


   
1.
For each xR In Range([A2], [A65536].End(3))
請問那個Range([A2]], [A65536].End(3))是什麼意思呢??
我知道[A65536].End(3)是A欄從最下面上來第一個非空白的儲存格
＿Ａ２到Ａ欄最後一個非空格的範圍　

2.
   If Trim(xR) = "小計" Then
   If N > 0 Then xR(1, 2) = "=SUM(" & Range(xR(0, 2), xR(1 - N, 2)).Address & ")": N = 0
請問xr(1,2)是什麼意思??
＿xR(1, 2) ＝ xR.Cells(1, 2)，相同意思　
作者: popomilk    時間: 2016-8-6 17:53

回復 9# 准提部林


謝謝你的解釋  我看懂了~~太高興了 (我研究了好久)
但接下來後面還是看不懂
那請問標紅色的是什麼意思阿?? 求神手再度開示
  If Trim(xR) = "小計" Then
If N > 0 Then xR(1, 2) = "=SUM(" & Range(xR(0, 2), xR(1 - N, 2)).Address & ")": N = 0
我現在大概知道的是這樣子
當一開始N數到4時 (A2-->A5)
由於A5是小計
因此當N=4時會啟動  If Trim(xR) = "小計" Then


xR(0,2)是從A5往上移一格，並往右移一格，
xR(0,2)=B4
xR(1 - N, 2)，當N為4-->xR(-3,2)
xR(-3,2)=是從A5要往上移四格，並往右移一格
xR(-3,2)=B1
Range(xR(0, 2), xR(1 - N, 2)).Address==>$B$1到$B$4的範圍


最後的:N=0似乎是 讓N重新歸零的樣子?
請問我在數N的時候都是按F8看著程式一個一個數，有什麼方法能馬上看到現在N跑到多少了嗎??


非常謝謝您撥冗教學
作者: 准提部林    時間: 2016-8-6 18:44

回復 10# popomilk


   
If N > 0 Then xR(1, 2) = "=SUM(" & Range(xR(0, 2), xR(1 - N, 2)).Address & ")": xR(0, 3) = N: N = 0

xR(0, 3) = N  當遇"小計"時, 記錄N值, 這樣應較可清楚其程序
碰到"小計"時, 匯整所需工作, 並將N值歸0, 繼續下一區段


"=SUM(" & Range(xR(0, 2), xR(1 - N, 2)).Address & ")"
&用來連接文字, 加上位址即成一個公式的文字串：=SUM($B$2:$B$4)
作者: 准提部林    時間: 2016-8-6 18:55

Sub Macro3()
Dim xR As Range, N&, xH As Range
For Each xR In Range([A2], [A65536].End(3))
　　If xR Like "###########" And N = 0 Then Set xH = xR(1, 2): N = 1
　　If Trim(xR) = "小計" Then
　　　　If N = 1 Then xR(1, 2) = "=SUM(" & Range(xH, xR(0, 2)).Address & ")":  N = 0
　　End If
　　If Trim(xR) = "總計" Then xR(1, 2) = "=SUMIF(R1C[-1]:R[-1]C[-1],""*小計*"",R1C:R[-1]C)"
Next
End Sub

這是另一方法，可以更精準抓小計範圍，
當Ａ欄有〔資產編號（１１碼數字）〕時，記錄為〔首格〕位置(xH)，
當遇"小計"時，〔首格〕至〔上右一格〕即為小計範圍！！！
作者: Joforn    時間: 2016-8-6 21:37

回復 4# popomilk
  1. Sub Test()
  2.   Dim I           As Long
  3.   Dim R As Long, EndRow As Long
  4.   Dim strValue    As String
  5.   Dim Ranges      As Range
  6.   Dim Range1      As Range
  7.   Dim strFormula  As String
  8.   
  9.   EndRow = Range("A" & Rows.Count).End(xlUp).Row
  10.   For I = 1 To EndRow
  11.     With Range("A" & I)
  12.       strValue = Trim$(.Value)
  13.       Select Case strValue
  14.         Case "小計"
  15.           .Offset(0, 1).FormulaR1C1 = "=SUM(R[" & R - I & "]C:R[-1]C)"
  16.           R = 0
  17.           If Ranges Is Nothing Then
  18.             Set Ranges = .Offset(0, 1)
  19.           Else
  20.             Set Ranges = Union(Ranges, .Offset(0, 1))
  21.           End If
  22.         Case "總計"
  23.           If Not Ranges Is Nothing Then
  24.             strFormula = vbNullString
  25.             For Each Range1 In Ranges
  26.               With Range1
  27.                 If Len(strFormula) Then
  28.                   strFormula = strFormula & "," & .Address
  29.                 Else
  30.                   strFormula = .Address
  31.                 End If
  32.               End With
  33.             Next Range1
  34.             Set Ranges = Nothing
  35.             .Offset(0, 1).Formula = "=SUM(" & strFormula & ")"
  36.           End If
  37.         Case Else
  38.           If R = 0 Then
  39.             If strValue Like "###########" Then R = I
  40.           End If
  41.       End Select
  42.     End With
  43.   Next
  44. End Sub
複製代碼
作者: popomilk    時間: 2016-8-7 18:58

回復 12# 准提部林

非常謝謝你花時間回覆
經過你的教學，我真的懂了很多!! (寫了很多筆記)Macro1 是用
在A欄用for each的用法，抓出小計的行數
並且在還沒抓到小計之前 一直讓N隨著行數N+1
碰到小計時 啟動sum 加總範圍用1-N的方式解決  (終於稍微懂sum在VB的用法了，感動)
加總後，再另N=0 重新開始




Macro3 相較於macro1的不同
應該就在發現A欄的編號都是11字元，
所以將xH = xR(1, 2)
在第一次碰到A欄有11字元時且N=0時，設定一個變數記錄該行的儲存格位置，並讓N為1
最後的N=1是避免再重覆設定XH這個變數，讓他就固定在第一次碰到11個字元時的那行的儲存格
在sum加總後，重新讓N為0
之後碰到11個字元時，再重新設定XH變數


花了好多時間了解這兩法寫的邏輯了
非常佩服你的聰明
猶如上了一堂課

最後想跟跟你請教標紅字的部分

If Trim(xR) = "總計" Then xR(1, 2) = "=SUMIF(R1C[-1]:R[-1]C[-1],""*小計*"",R1C:R[-1]C)"

一般excel
sumif這個函數我是知道的
sumif(要被判斷的範圍區間，判斷條件,加總範圍)
我看不太懂R1C[-1]
我查網路上說是相對位置
但是如果在excel應該是要設置成 =SUMIF(A:A,"*小計*",B:B)
實在是看不懂轉成VB語言後是打成這樣

麻煩再請大師撥冗解答一下
非常感謝
作者: popomilk    時間: 2016-8-7 19:40

回復 13# Joforn
感謝Joforn的花時間幫我


想再請教您紅色部分
For I = 1 To EndRow   
請問這邊要怎麼寫成For each
我換成這樣一直顯示錯誤
For Each I In Range([A1], EndRow)
這兩種判斷式是算相同功能的嗎??

感謝
作者: 准提部林    時間: 2016-8-7 20:09

回復 14# popomilk


   
xR(1, 2) = "=SUMIF(R1C[-1]:R[-1]C[-1],""*小計*"",R1C:R[-1]C)"　
這個是先寫公式．Ｂ２２：=SUMIF(A$1:A21,"*小計*",B$1:B21)
再以〔錄製〕取得程式碼的！
作者: popomilk    時間: 2016-8-7 20:24

回復 16# 准提部林

非常謝謝
我都忘記有這方式了!
感謝您的分享
作者: Joforn    時間: 2016-8-7 22:50

回復 14# popomilk
Sub Test()
  Dim xR As Range
  
  Set xR = Range("A7")
  With xR
    If Trim$(.Value) = "總計" Then
      .Offset(0, 1).Formula = "=SUMIF(A:A,""*小計*"",B:B)"
      '.Offset(0, 1).FormulaR1C1 = "=SUMIF(C[-1],""*小計*"",C)" '這條語句與上一條語句在這裡是相同的效果，但不同的位置公式不一樣，所以上面那條比較好用。
    End If
  End With
End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)