■ 改修のポイント
- 「引落」のカード名は、頭に“@”(全角アットマーク)を付ける。
- SumIfs関数で、“=引落”としている時は、“=@*”の値を加える。
- SumIfs関数で、“<>引落”としている時は、“=@*”の値を差し引く。
集計する() ‥‥ マクロ家計簿 version 1.23(改修後)
- Public Sub 集計する()
- Dim mbTitle As String
- Dim wksWorkSheet As Worksheet
- Dim i As Long, lastRow As Long, nowColumn As Long
- Dim strHimoku As String
- Dim clearOnly As Boolean
- mbTitle = "集計する/" & ThisWorkbook.Name
- clearOnly = False
- Worksheets(nowSheetName).Select
- If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
- clearOnly = False
- lngAns = 入力チェック(nowSheetName)
- If lngAns < 0 Then
- clearOnly = True
- ElseIf lngAns > 0 Then
- GoTo Exit_集計する
- End If
- If Not clearOnly Then boolAns = sort日付昇順(nowSheetName)
- '2014.06.18 コメントアウト
- nowColumn = get費目Column(nowSheetName) '費目シートの列を求める
- If nowColumn = 0 Then
- MsgBox "費目シートの集計する列が見つかりません。" & vbCrLf & vbCrLf _
- & " ■シート名=" & nowSheetName, vbCritical, mbTitle
- Exit Sub
- End If
- '2014.06.18 上記コメントアウトし、下記1行を追加した。
- boolAns = 費目別に支出を合計する(nowSheetName)
- If Not clearOnly Then boolAns = カードシートを集計する(nowSheetName)
- '費目・シート/入金および総計を集計する。
- lastRow = Worksheets(nowSheetName).Range("D1").End(xlDown).Row
- If lastRow = Rows.Count Then lastRow = 2
- Worksheets("費目").Select
- '総入金計
- Cells(2, nowColumn) = Application.WorksheetFunction _
- .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("F2:F" & lastRow))
- '費目/入金
- Cells(3, nowColumn) = Application.WorksheetFunction _
- .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow), "入金" _
- , Worksheets(nowSheetName).Range("F2:F" & lastRow))
- 'カード/引落
- Cells(4, nowColumn) = Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "引落") _
- + Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "@*")
- 'その他
- Cells(5, nowColumn) = Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>入金" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>引落") _
- - Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("F2:F" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>入金" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "@*")
- '総支出計
- Cells(6, nowColumn) = Application.WorksheetFunction _
- .SumIf(Worksheets(nowSheetName).Range("D2:D" & lastRow) _
- , "<>チャージ", Worksheets(nowSheetName).Range("G2:G" & lastRow))
- '現金
- Cells(7, nowColumn) = Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "=")
- '引落
- Cells(8, nowColumn) = Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "=引落") _
- + Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "@*")
- 'プリペイド
- Cells(9, nowColumn) = Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>引落") _
- - Application.WorksheetFunction _
- .SumIfs(Worksheets(nowSheetName).Range("G2:G" & lastRow) _
- , Worksheets(nowSheetName).Range("D2:D" & lastRow), "<>チャージ" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "<>" _
- , Worksheets(nowSheetName).Range("E2:E" & lastRow), "@*")
- Call A列で並べる(nowSheetName)
- '日付の最後の次のセルを選択する。
- Worksheets(nowSheetName).Select
- lastRow = Range("B1").End(xlDown).Row
- If lastRow = Rows.Count Then
- Range("B2").Select
- Else
- Cells(lastRow + 1, 2).Select
- End If
- '終了
- Worksheets("カード").Select
- Range("A1").Select
- Exit_集計する:
- Application.ScreenUpdating = True '画面を更新する。
- ThisWorkbook.Close (False)
- End Sub