123
返回列表 上一主題 發帖

[發問] 2個條件的加總

yliu

帖子
49 
主題
8 
精華
0 
積分
63 
點名
0  
作業系統
windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
女 
來自
高雄 
註冊時間
2013-4-8 
最後登錄
2013-10-30 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-5-30 23:34 | 只看該作者

[發問] 2個條件的加總

請問各位高手,

我要將原始資料裡依類別與日期這兩個條件將金額加總到"總表",例如: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

圖二.jpg (59.32 KB)

圖二.jpg

收藏 分享
learner

kimbal

帖子
472 
主題
5 
精華
0 
積分
485 
點名
0  
作業系統
Windows 
軟體版本
MS Office 
閱讀權限
100 
性別
男 
來自
香港 
註冊時間
2010-7-4 
最後登錄
2014-12-28 

論壇貢獻勳章
2#
發表於 2013-5-31 01:38 | 只看該作者
本帖最後由 kimbal 於 2013-5-31 01:40 編輯

回復 1# yliu
  1. Private Sub CommandButton2_Click()
  2. Application.ScreenUpdating = False
  3. Application.Calculation = xlCalculationManual

  5. Dim rowcnt As Long
  6. Dim i As Long

  8. Dim lngVlookupRow As Long
  9. Dim lngCurrenMonth As Long
  10. Dim lngCurrValue As Long

  12. '清理舊數據
  13. Sheets("總表").Activate
  14. Sheets("總表").Range("A3").CurrentRegion.Offset(1, 1).Clear


  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

  36. Application.Calculation = xlCalculationAutomatic
  37. Application.ScreenUpdating = True
  38. End Sub
複製代碼
懂得發問,答案就會在其中

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

TOP

yliu

帖子
49 
主題
8 
精華
0 
積分
63 
點名
0  
作業系統
windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
女 
來自
高雄 
註冊時間
2013-4-8 
最後登錄
2013-10-30 

論壇贊助勳章
3#
發表於 2013-5-31 12:30 | 只看該作者
回復 2# kimbal
謝謝kimbal.
但出現執行階段錯誤’13’: 型態不符合
偵錯在: With Sheets("總表").Cells(lngVlookupRow, lngCurrenMonth + 1) '放數據到總表上
learner

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
4#
發表於 2013-5-31 13:07 | 只看該作者
回復 1# yliu
有考慮直接用樞紐分析表嗎?
a.gif

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
5#
發表於 2013-5-31 13:10 | 只看該作者
回復 1# yliu

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

TOP

kimbal

帖子
472 
主題
5 
精華
0 
積分
485 
點名
0  
作業系統
Windows 
軟體版本
MS Office 
閱讀權限
100 
性別
男 
來自
香港 
註冊時間
2010-7-4 
最後登錄
2014-12-28 

論壇貢獻勳章
6#
發表於 2013-5-31 13:27 | 只看該作者
回復 3# yliu


    可否提供一下EXCEL?

另外也會建議用PIVOTTABLE 和SUMIFS
VBA LOOP很多情況也是比公式慢的.
懂得發問,答案就會在其中

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

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
7#
發表於 2013-5-31 16:23 | 只看該作者
回復  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

  5.     Application.ScreenUpdating = False
  6.     Application.Calculation = xlCalculationManual

  8.     '  清理舊數據
  9.     Sheets("總表").Activate
  10.     Sheets("總表").Range("A3").CurrentRegion.Offset(1, 1).Clear


  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
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
8#
發表於 2013-5-31 19:52 | 只看該作者
本帖最後由 c_c_lai 於 2013-5-31 19:55 編輯

請將 4 改成 3.2
  1.                     .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 3.2))) = .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth /3.2))) + lngCurrValue
複製代碼

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
9#
發表於 2013-5-31 21:16 | 只看該作者
如附件：
兩個條件的加總.rar (20.85 KB)

TOP

yliu

帖子
49 
主題
8 
精華
0 
積分
63 
點名
0  
作業系統
windows XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
女 
來自
高雄 
註冊時間
2013-4-8 
最後登錄
2013-10-30 

論壇贊助勳章
10#
發表於 2013-5-31 23:53 | 只看該作者
回復 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 的作用是什麼?
learner

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
123
返回列表 上一主題