家計簿77/カード「引落」の複数化対応−2(改修後)

改修のポイント

  • 「引落」のカード名は、頭に“@”(全角アットマーク)を付ける。
  • SumIfs関数で、“=引落”としている時は、“=@*”の値を加える。
  • SumIfs関数で、“<>引落”としている時は、“=@*”の値を差し引く。

集計する() ‥‥ マクロ家計簿 version 1.23(改修後)

  1. Public Sub 集計する()
  2. Dim mbTitle As String
  3. Dim wksWorkSheet As Worksheet
  4. Dim i As Long, lastRow As Long, nowColumn As Long
  5. Dim strHimoku As String
  6. Dim clearOnly As Boolean
  7.  
  8. mbTitle = "集計する/" & ThisWorkbook.Name
  9. clearOnly = False
  10. Worksheets(nowSheetName).Select
  11. If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
  12.  
  13. clearOnly = False
  14. lngAns = 入力チェック(nowSheetName)
  15. If lngAns < 0 Then
  16. clearOnly = True
  17. ElseIf lngAns > 0 Then
  18. GoTo Exit_集計する
  19. End If
  20.  
  21. If Not clearOnly Then boolAns = sort日付昇順(nowSheetName)
  22. '2014.06.18 コメントアウト
  23. nowColumn = get費目Column(nowSheetName)   '費目シートの列を求める
  24. If nowColumn = 0 Then
  25. MsgBox "費目シートの集計する列が見つかりません。" & vbCrLf & vbCrLf _
  26. & " ■シート名=" & nowSheetName, vbCritical, mbTitle
  27. Exit Sub
  28. End If
  29. '2014.06.18 上記コメントアウトし、下記1行を追加した。
  30. boolAns = 費目別に支出を合計する(nowSheetName)
  31.  
  32. If Not clearOnly Then boolAns = カードシートを集計する(nowSheetName)
  33. '費目・シート/入金および総計を集計する。
  34. lastRow = Worksheets(nowSheetName).Range("D1").End(xlDown).Row
  35. If lastRow = Rows.Count Then lastRow = 2
  36. Worksheets("費目").Select
  37. '総入金計
  38. Cells(2, nowColumn) = Application.WorksheetFunction _
  39. .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  40. , Worksheets(nowSheetName).Range("F2:F" & lastRow))
  41. '費目/入金
  42. Cells(3, nowColumn) = Application.WorksheetFunction _
  43. .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow), "入金" _
  44. , Worksheets(nowSheetName).Range("F2:F" & lastRow))
  45. 'カード/引落
  46. Cells(4, nowColumn) = Application.WorksheetFunction _
  47. .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
  48. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  49. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "引落") _
  50. + Application.WorksheetFunction _
  51. .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
  52. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  53. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "@*")
  54. 'その他
  55. Cells(5, nowColumn) = Application.WorksheetFunction _
  56. .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
  57. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  58. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>入金" _
  59. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>引落") _
  60. - Application.WorksheetFunction _
  61. .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
  62. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  63. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>入金" _
  64. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "@*")
  65. '総支出計
  66. Cells(6, nowColumn) = Application.WorksheetFunction _
  67. .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow) _
  68. , "<>チャージ", Worksheets(nowSheetName).Range("G2:G" & lastRow))
  69. '現金
  70. Cells(7, nowColumn) = Application.WorksheetFunction _
  71. .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
  72. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  73. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "=")
  74. '引落
  75. Cells(8, nowColumn) = Application.WorksheetFunction _
  76. .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
  77. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  78. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "=引落") _
  79. + Application.WorksheetFunction _
  80. .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
  81. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  82. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "@*")
  83. 'プリペイド
  84. Cells(9, nowColumn) = Application.WorksheetFunction _
  85. .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
  86. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  87. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>" _
  88. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>引落") _
  89. - Application.WorksheetFunction _
  90. .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
  91. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  92. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>" _
  93. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "@*")
  94.  
  95. Call A列で並べる(nowSheetName)
  96. '日付の最後の次のセルを選択する。
  97. Worksheets(nowSheetName).Select
  98. lastRow = Range("B1").End(xlDown).Row
  99. If lastRow = Rows.Count Then
  100. Range("B2").Select
  101. Else
  102. Cells(lastRow + 1, 2).Select
  103. End If
  104. '終了
  105. Worksheets("カード").Select
  106. Range("A1").Select
  107.  
  108. Exit_集計する:
  109. Application.ScreenUpdating = True   '画面を更新する。
  110. ThisWorkbook.Close (False)
  111.  
  112. End Sub