12
返回列表 上一主題 發帖

[發問] VBA自動加總

popomilk

帖子
34 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
WIN7 
軟體版本
WIN7 
閱讀權限
20 
性別
男 
註冊時間
2016-7-11 
最後登錄
2016-12-2 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-8-4 15:56 | 只看該作者

[發問] VBA自動加總

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

請問有前輩能教學嗎
感謝

加總.rar (7.81 KB)

收藏 分享

Joforn
　暱稱: 南宮飄雪

中學生Rank: 2

帖子
109 
主題
2 
精華
0 
積分
114 
點名
0  
作業系統
Win7 Win10 
軟體版本
Office 2019 WPS 
閱讀權限
20 
性別
男 
來自
深圳 
註冊時間
2013-2-2 
最後登錄
2024-4-9 
2#
發表於 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
複製代碼
世界那麼大，可我想去哪？

TOP

popomilk

帖子
34 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
WIN7 
軟體版本
WIN7 
閱讀權限
20 
性別
男 
註冊時間
2016-7-11 
最後登錄
2016-12-2 

論壇贊助勳章
3#
發表於 2016-8-5 13:41 | 只看該作者
回復 2# Joforn


  Joforn實在太神了
請容許我在學習之前 讓我先膜拜您
非常感謝

TOP

popomilk

帖子
34 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
WIN7 
軟體版本
WIN7 
閱讀權限
20 
性別
男 
註冊時間
2016-7-11 
最後登錄
2016-12-2 

論壇贊助勳章
4#
發表於 2016-8-5 13:47 | 只看該作者
回復 2# Joforn


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

感謝!!

加總2.rar (8.61 KB)

TOP

popomilk

帖子
34 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
WIN7 
軟體版本
WIN7 
閱讀權限
20 
性別
男 
註冊時間
2016-7-11 
最後登錄
2016-12-2 

論壇贊助勳章
5#
發表於 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)""

非常感謝

TOP

准提部林

帖子
2808 
主題
10 
精華
0 
積分
2864 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-5-10 
6#
發表於 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
複製代碼
兩種方法!!!

TOP

准提部林

帖子
2808 
主題
10 
精華
0 
積分
2864 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-5-10 
7#
發表於 2016-8-5 14:34 | 只看該作者
方法二的公式:
小計:=SUM(B$1:B4)-SUMIF(A$1:A4,"*小計*",B$1:B4)*2
總計:=SUMIF(A$1:A21,"*小計*",B$1:B21)

TOP

popomilk

帖子
34 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
WIN7 
軟體版本
WIN7 
閱讀權限
20 
性別
男 
註冊時間
2016-7-11 
最後登錄
2016-12-2 

論壇贊助勳章
8#
發表於 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)是什麼意思??

  非常感謝!!

TOP

准提部林

帖子
2808 
主題
10 
精華
0 
積分
2864 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-5-10 
9#
發表於 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)，相同意思　

TOP

popomilk

帖子
34 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
WIN7 
軟體版本
WIN7 
閱讀權限
20 
性別
男 
註冊時間
2016-7-11 
最後登錄
2016-12-2 

論壇贊助勳章
10#
發表於 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跑到多少了嗎??


非常謝謝您撥冗教學

圖片 003.png (5.05 KB)

圖片 003.png

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
12
返回列表 上一主題