返回列表 上一主題 發帖

[發問] 2個條件的加總

本帖最後由 kimbal 於 2013-5-31 01:40 編輯

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

  4. Dim rowcnt As Long
  5. Dim i As Long

  6. Dim lngVlookupRow As Long
  7. Dim lngCurrenMonth As Long
  8. Dim lngCurrValue As Long

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


  12. Sheets("原始資料").Activate
  13. With Sheets("原始資料")
  14.     rowcnt = .Cells(1, 1).CurrentRegion.Rows.Count
  15.     For i = 1 To rowcnt
  16.         lngCurrenMonth = 0
  17.         If IsDate(.Cells(i, 2)) Then
  18.             lngCurrenMonth = Month(.Cells(i, 2)) '當行月份
  19.         End If
  20.         If lngCurrenMonth > 0 And Not (IsError(Application.Match(.Cells(i, 1), Sheets("總表").Range("A:A"), 0))) Then
  21.             lngVlookupRow = Application.Match(.Cells(i, 1), Sheets("總表").Range("A:A"), 0) '當行類型在總表行數
  22.             lngCurrValue = .Cells(i, 3)
  23.             With Sheets("總表").Cells(lngVlookupRow, lngCurrenMonth + 1) '放數據到總表上
  24.                 .Value = .Value + lngCurrValue
  25.             End With
  26.         End If
  27.     Next
  28.    
  29. End With

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

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

TOP

回復 3# yliu


    可否提供一下EXCEL?

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

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

TOP

        靜思自在 : 要比誰更受誰.不要比誰更怕誰。
返回列表 上一主題