如何設定自動加總vba程式

agwhk

請教如下圖所示vba程式怎樣寫?
謝謝 !!!

下載 (30.12 KB)

2013-10-5 10:11

kimbal

回復 1# agwhk

1.     Sub test()
   
2. Dim firstPos As Long, currRow As Long, lastrow As Long
   
3. Dim startRng As Range
   
4. 
   
5.    
   
6.     Set startRng = ActiveSheet.Range("B3")
   
7.    
   
8.     lastrow = Range("B65536").End(xlUp).Row + 1
   
9.     currRow = 0
   
10.    
    
11.     Do
    
12.         With startRng
    
13.             If UCase(Left(.Offset(currRow, 0).Offset(0, -1), 8)) = "SUBTOTAL" Then
    
14.                 .Offset(currRow, 0).Value = Application.WorksheetFunction.Sum(Range(.Offset(firstPos, 0), .Offset(currRow - 1, 0)))
    
15.                 firstPos = currRow + 1
    
16.             End If
    
17.         End With
    
18.         currRow = currRow + 1
    
19.         
    
20.     Loop While startRng.Offset(currRow).Row <= lastrow
    
21. 
    
22. End Sub

複製代碼

agwhk

謝謝 kimbal 大哥 , 正是我須要的程式非常感謝!!!