[發問] 2個條件的加總

yliu

請問各位高手,

我要將原始資料裡依類別與日期這兩個條件將金額加總到"總表",例如:1/1~1/31, A類金額加總後放到B4儲存格,2/1~2/28, A類金額加總後放到C4儲存格,3/1~3/31, A類金額加總後放到D4儲存格..以此類推
原本使用工作表函數SUMPRODUCT, 但資料量多時,工作表run重新計算會花很多時間, 想改用VBA方式.
但我只會用下列寫法,發現這樣寫法要寫很多的IF判斷,想請問各位高手 提供較好的寫法.感謝!

Private Sub CommandButton2_Click()
Dim rowcnt As Integer
Dim i As Integer
Dim sum_A_1, sum_A_2, sum_A_3,sum_A_4,sum_A_5,sum_A_6,sum_A_7,sum_A_8,sum_A_9,sum_A_10,sum_A_11,sum_A_12 As Variant
sum_A_1= 0 '統計A類1月份金額
sum_A_2= 0 '統計A類2月份金額
sum_A_3= 0 '統計A類3月份金額
sum_A_4= 0 '統計A類4月份金額
sum_A_5= 0 '統計A類5月份金額

Sheets("原始資料").Activate
With Sheets("原始資料")
rowcnt= .Cells(1, 1).CurrentRegion.Rows.Count

For i = 1 To rowcnt
    '加總A類一月份金額
    If .Cells(i,2) >= "2013/1/1"And .Cells(i, 2) <= "2013/1/31" And .Cells(i,1) = Sheets("總表").Range("A4") Then
        sum_A_1= sum_A_1 + (Cells(i, 3).Value)
        Sheets("總表").Range("B4") = sum_A_1
    End If
   '加總A類二月份金額
     If .Cells(i,2) >= "2013/2/1"And .Cells(i, 2) <= "2013/2/28" And .Cells(i,1) = Sheets("總表").Range("A4") Then
        sum_A_2= sum_A_2+ (Cells(i, 3).Value)
        Sheets("總表").Range("C4") = sum_A_2   
     End If
Next

End With
End Sub

下載 (59.32 KB)
原始資料

2013-5-30 23:04

下載 (62.72 KB)
總表

2013-5-30 23:06

kimbal

回復 1# yliu

1. Private Sub CommandButton2_Click()
   
2. Application.ScreenUpdating = False
   
3. Application.Calculation = xlCalculationManual
   
4. 
   
5. Dim rowcnt As Long
   
6. Dim i As Long
   
7. 
   
8. Dim lngVlookupRow As Long
   
9. Dim lngCurrenMonth As Long
   
10. Dim lngCurrValue As Long
    
11. 
    
12. '清理舊數據
    
13. Sheets("總表").Activate
    
14. Sheets("總表").Range("A3").CurrentRegion.Offset(1, 1).Clear
    
15. 
    
16. 
    
17. Sheets("原始資料").Activate
    
18. With Sheets("原始資料")
    
19.     rowcnt = .Cells(1, 1).CurrentRegion.Rows.Count
    
20.     For i = 1 To rowcnt
    
21.         lngCurrenMonth = 0
    
22.         If IsDate(.Cells(i, 2)) Then
    
23.             lngCurrenMonth = Month(.Cells(i, 2)) '當行月份
    
24.         End If
    
25.         If lngCurrenMonth > 0 And Not (IsError(Application.Match(.Cells(i, 1), Sheets("總表").Range("A:A"), 0))) Then
    
26.             lngVlookupRow = Application.Match(.Cells(i, 1), Sheets("總表").Range("A:A"), 0) '當行類型在總表行數
    
27.             lngCurrValue = .Cells(i, 3)
    
28.             With Sheets("總表").Cells(lngVlookupRow, lngCurrenMonth + 1) '放數據到總表上
    
29.                 .Value = .Value + lngCurrValue
    
30.             End With
    
31.         End If
    
32.     Next
    
33.    
    
34. End With
    
35. 
    
36. Application.Calculation = xlCalculationAutomatic
    
37. Application.ScreenUpdating = True
    
38. End Sub

複製代碼

yliu

回復 2# kimbal
謝謝kimbal.
但出現執行階段錯誤’13’: 型態不符合
偵錯在: With Sheets("總表").Cells(lngVlookupRow, lngCurrenMonth + 1) '放數據到總表上

stillfish00

回復 1# yliu
有考慮直接用樞紐分析表嗎?

下載 (425.48 KB)

2013-5-31 13:07

sunnyso

回復 1# yliu

可以考慮用 SUMIFS 來代替 SUMPRODUCT， 因爲SUMIFS更有效率

kimbal

回復 3# yliu


    可否提供一下EXCEL?

另外也會建議用PIVOTTABLE 和SUMIFS
VBA LOOP很多情況也是比公式慢的.

c_c_lai

回復  kimbal
謝謝kimbal.
但出現執行階段錯誤’13’: 型態不符合
偵錯在: With Sheets("總表").Cells( ...
yliu 發表於 2013-5-31 12:30

回復 2# kimbal
不好意思，我稍微添加了幾行，希望您等能笑納！

1. Private Sub Ex()
   
2.     Dim rowcnt As Long, i As Long
   
3.     Dim lngVlookupRow As Long, lngCurrenMonth As Long, lngCurrValue As Long
   
4. 
   
5.     Application.ScreenUpdating = False
   
6.     Application.Calculation = xlCalculationManual
   
7. 
   
8.     '  清理舊數據
   
9.     Sheets("總表").Activate
   
10.     Sheets("總表").Range("A3").CurrentRegion.Offset(1, 1).Clear
    
11. 
    
12. 
    
13.     Sheets("原始資料").Activate
    
14.     With Sheets("原始資料")
    
15.         rowcnt = .Cells(1, 1).CurrentRegion.Rows.Count
    
16.         For i = 2 To rowcnt
    
17.             lngCurrenMonth = 0
    
18.             If IsDate(.Cells(i, 2)) Then
    
19.                 lngCurrenMonth = Month(.Cells(i, 2))                                               '  當行月份
    
20.             End If
    
21.             
    
22.             If lngCurrenMonth > 0 And Not (IsError(Application.Match(.Cells(i, 1), Sheets("總表").Range("A:A"), 0))) Then
    
23.                 lngVlookupRow = Application.Match(.Cells(i, 1), Sheets("總表").Range("A:A"), 0)    '  當行類型在總表行數
    
24.                 lngCurrValue = .Cells(i, 3)
    
25.                 With Sheets("總表")
    
26.                     .Cells(lngVlookupRow, lngCurrenMonth + 1).Value = .Cells(lngVlookupRow, lngCurrenMonth + 1).Value + lngCurrValue                       '  放數據到總表上
    
27.                     .Cells(lngVlookupRow, "N") = .Cells(lngVlookupRow, "N") + lngCurrValue
    
28.                     .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 4))) = .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 4))) + lngCurrValue
    
29.                 End With
    
30.             End If
    
31.         Next
    
32.     End With
    
33.    
    
34.     With Sheets("總表")
    
35.         rowcnt = .[A3].End(xlDown).Row
    
36.         For i = 2 To 18
    
37.             .Cells(rowcnt, i) = WorksheetFunction.Sum(.Range(Chr(64 + i) & 4 & ":" & Chr(64 + i) & (rowcnt - 1)))
    
38.         Next i
    
39.     End With
    
40.    
    
41.     Application.Calculation = xlCalculationAutomatic
    
42.     Application.ScreenUpdating = True
    
43. End Sub

複製代碼

c_c_lai

請將 4 改成 3.2

1.                     .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 3.2))) = .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth /3.2))) + lngCurrValue

複製代碼

c_c_lai

如附件：
兩個條件的加總.rar (20.85 KB)

下載次數: 15

2013-5-31 21:16

yliu

回復 9# c_c_lai


   謝謝 c_c_lai,
   可以使用了, 感謝~
  再請問一下,   
.Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 3.2))) = .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 3.2))) + lngCurrValue  '

除以3.2 的作用是什麼?