まりふのひと

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

改修のポイント

  1. オートチャージの(プリペイド)カードは、いわゆる「チャージ」はしないので、「引落」(口座引き落としで商品を購入した場合)と現象は同じ。
  2. 「引落」は1本なので、何のクレジットカードで購入したかわからない。
  3. そこで、「複数の引落」を持てるようにしようとするもの。

改修前(マクロ家計簿 version 1.22a)マクロ(Excel-VBA

集計する()
 “引落” をマジェンタ色で表示した。

  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. nowColumn = get費目Column(nowSheetName)   '費目シートの列を求める
  23. If nowColumn = 0 Then
  24. MsgBox "費目シートの集計する列が見つかりません。" & vbCrLf & vbCrLf _
  25. & " ■シート名=" & nowSheetName, vbCritical, mbTitle
  26. Exit Sub
  27. End If
  28. '2014.06.18 上記コメントアウトし、下記1行を追加した。
  29. boolAns = 費目別に支出を合計する(nowSheetName)
  30.  
  31. If Not clearOnly Then boolAns = カードシートを集計する(nowSheetName)
  32. '費目・シート/入金および総計を集計する。
  33. lastRow = Worksheets(nowSheetName).Range("D1").End(xlDown).Row
  34. If lastRow = Rows.Count Then lastRow = 2
  35. Worksheets("費目").Select
  36. '総入金計
  37. Cells(2, nowColumn) = Application.WorksheetFunction _
  38. .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  39. , Worksheets(nowSheetName).Range("F2:F" & lastRow))
  40. '費目/入金
  41. Cells(3, nowColumn) = Application.WorksheetFunction _
  42. .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow), "入金" _
  43. , Worksheets(nowSheetName).Range("F2:F" & lastRow))
  44. 'カード/引落
  45. Cells(4, nowColumn) = Application.WorksheetFunction _
  46. .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
  47. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  48. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "引落")
  49. 'その他
  50. Cells(5, nowColumn) = Application.WorksheetFunction _
  51. .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
  52. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  53. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>入金" _
  54. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>引落")
  55. '総支出計
  56. Cells(6, nowColumn) = Application.WorksheetFunction _
  57. .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow) _
  58. , "<>チャージ", Worksheets(nowSheetName).Range("G2:G" & lastRow))
  59. '現金
  60. Cells(7, nowColumn) = Application.WorksheetFunction _
  61. .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
  62. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  63. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "=")
  64. '引落
  65. Cells(8, nowColumn) = Application.WorksheetFunction _
  66. .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
  67. , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
  68. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "=引落")
  69. 'プリペイド
  70. Cells(9, 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. , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>引落")
  75.  
  76. Call A列で並べる(nowSheetName)
  77. '日付の最後の次のセルを選択する。
  78. Worksheets(nowSheetName).Select
  79. lastRow = Range("B1").End(xlDown).Row
  80. If lastRow = Rows.Count Then
  81. Range("B2").Select
  82. Else
  83. Cells(lastRow + 1, 2).Select
  84. End If
  85. '終了
  86. Worksheets("カード").Select
  87. Range("A1").Select
  88.  
  89. Exit_集計する:
  90. ThisWorkbook.Close (False)
  91.  
  92. End Sub


カードシートを集計する()
 改修の必要はない‥‥ と、判断した。

  1. Function カードシートを集計する(argSheetName As String) As Boolean
  2. Dim mbTitle As String
  3. Dim isAutoFil As Boolean
  4. Dim lastRow As Long, lastCard As Long
  5. Dim strString As String
  6.  
  7. mbTitle = "カードシートを集計する/" & ThisWorkbook.Name
  8. Sheets(argSheetName).Select
  9. lastRow = Range("D1").End(xlDown).Row
  10.  
  11. Sheets("カード").Select
  12. strAns = ActiveWorkbook.Name
  13. strAns = Left(strAns, InStrRev(strAns, ".") - 1)
  14. Range("B1") = strAns  'ファイル名
  15. Range("B2") = argSheetName   'シート名
  16. Range("D1") = Application.WorksheetFunction.Max(Worksheets(argSheetName).Range("B2:B" & lastRow)) '最終日付
  17. Range("D2") = Now()   '集計日
  18.  
  19. Range("B5").Select   '財布の中/収入
  20. '2014.09.03 カードが空の入金計に変更した。
  21. strString = "=SUMIF('" & argSheetName & "'!E2:E" & lastRow & ","""",'" _
  22. & argSheetName & "'!F2:F" & lastRow & ")"
  23. ActiveCell.Formula = strString
  24. Range("C5").Select   '財布の中/支出
  25. strString = "=SUMIF('" & argSheetName & "'!D2:D" & lastRow & ",""チャージ"",'" _
  26. & argSheetName & "'!G2:G" & lastRow & ")"
  27. ActiveCell.Formula = strString
  28. '財布の中/支出(現金)
  29. Range("D5").Select
  30. '2014.08.08 入金(F列)を差し引くようにした。
  31. strString = "=SUMIF('" & argSheetName & "'!E2:E" & lastRow & ","""",'" _
  32. & argSheetName & "'!G2:G" & lastRow & ")"
  33. ActiveCell.Formula = strString
  34. '財布の中/残高
  35. Range("E5").Select
  36. strString = "=B5-C5-D5"
  37. ActiveCell.Formula = strString
  38. 'カード名の最終行をセットする。
  39. lastCard = Range("A7").End(xlDown).Row
  40. If lastCard > 500 + 7 Then
  41. MsgBox "カード名が無いか、仕様を超えています!" & vbCrLf & vbCrLf _
  42. & " ■最終行=" & lastCard & vbCrLf & vbCrLf _
  43. & "カード名「引落」は省略できません。", vbCritical, mbTitle
  44. Exit Function
  45. End If
  46. If lastCard > 8 Then isAutoFil = True Else isAutoFil = False
  47. '入金の計算式
  48. Range("B8").Select
  49. strString = "=SUMIF('" & argSheetName & "'!$E$2:$E$" & lastRow & ",A8,'" _
  50. & argSheetName & "'!$F$2:$F$" & lastRow & ")"
  51. ActiveCell.Formula = strString
  52. 'オートフィルでコピーする。
  53. If isAutoFil Then
  54. Range("B8").Select
  55. Selection.AutoFill Destination:=Range("B8:B" & lastCard)
  56. End If
  57. 'チャージの計算式
  58. Range("C8").Select
  59. strString = "=SUMIFS('" & argSheetName & "'!$G$2:$G$" & lastRow & ",'" _
  60. & argSheetName & "'!$D$2:$D$" & lastRow & ",""チャージ"",'" _
  61. & argSheetName & "'!$E$2:$E$" & lastRow & ",A8)"
  62. ActiveCell.Formula = strString
  63. If isAutoFil Then Range("C8").AutoFill Destination:=Range("C8:C" & lastCard)
  64. '支出
  65. Range("D8").Select
  66. strString = "=SUMIF('" & argSheetName & "'!$E$2:$E$" & lastRow & ",A8,'" _
  67. & argSheetName & "'!$G$2:$G$" & lastRow & ")-C8"
  68. ActiveCell.Formula = strString
  69. If isAutoFil Then Range("D8").AutoFill Destination:=Range("D8:D" & lastCard)
  70. '残高
  71. Range("E8").Select
  72. strString = "=B8+C8-D8"
  73. ActiveCell.Formula = strString
  74. If isAutoFil Then Range("E8").AutoFill Destination:=Range("E8:E" & lastCard)
  75.  
  76. End Function