2022年3月7日月曜日

医療費管理のピポットテーブルを作りました。ついでにマクロも導入しました。

ブログネタがないのかオイラの書く気がないのかわからないが

前回のブログ投稿よりだいぶ日にちが経ちました。


毎年の医療費が確定申告してお金が戻ってくる金額になっています。

オイラの場合は年間3万か4万円を超えると還付対象になります。

例え3桁の還付金でも住民税への影響がありますので申告した方がいいです。

ただ3桁だとe-taxを使わないと(還付金)ー(郵便料金)で損をしますので注意です。

e-taxなら現金の支出はないです。


去年までは各医療機関ごとに利用日にち、医療費、備考をいれていました。

こちらは医療機関ごとに分けて入力が必要です。
利用日は特に順番でなくても構わない。

これはこれで使えるのですがもっといい方法があるのを知り作っていくことにしました。

それはピポットテーブルです。

データー入力は医療機関、日付、金額、備考が順番でなくてもよい。

A医療機関の下にC医療機関、B医療機関でも問題なし。

また利用日にちも順番でなくてもいい。

医療機関で領収書をもらって直ぐに入力してもよいし

まとめて医療機関、日付、金額を入力してもよい。



左端の表だけでデーター入力は終わりです。

もう少し使いやすくするために医療機関はリスト化(右の表)しました。

このままでも手作業でピポットテーブルは作っていけますが

もう少し手間がかからないようにマクロを作っていきました。

マクロ開始ボタン(ピポットテーブルON)を作り

これを押せば中央の表が表示されます。

マクロ式は下記のとおりです。

Sub ピポットテーブル01()

' ピポットテーブル01 Macro

   Application.ScreenUpdating = False

   ' F列からJ列のデーターを削除

    Columns("F:J").Select

    Selection.ClearContents

'シート名変えたら(医療費データー)下の部分も変えること

'2ケ所ある

    Range("B1").Select

    Selection.End(xlDown).Select

    Range(Selection, Selection.End(xlDown)).Select

    Range(Selection, Selection.End(xlToRight)).Select

    Application.CutCopyMode = False

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

        "医療費データー!R3C2:R200C5", Version:=7).CreatePivotTable TableDestination:= _

        "医療費データー!R3C7", TableName:="ピボットテーブル1", DefaultVersion:=7

    ActiveSheet.Select

 'シート名変えたら(医療費データー)上の部分も変えること


    Range("G3").Select

    'Cells(3, 7).Select

    With ActiveSheet.PivotTables("ピボットテーブル1")

        .ColumnGrand = True

        .HasAutoFormat = True

        .DisplayErrorString = False

        .DisplayNullString = True

        .EnableDrilldown = True

        .ErrorString = ""

        .MergeLabels = False

        .NullString = ""

        .PageFieldOrder = 2

        .PageFieldWrapCount = 0

        .PreserveFormatting = True

        .RowGrand = True

        .SaveData = True

        .PrintTitles = False

        .RepeatItemsOnEachPrintedPage = True

        .TotalsAnnotation = False

        .CompactRowIndent = 1

        .InGridDropZones = False

        .DisplayFieldCaptions = True

        .DisplayMemberPropertyTooltips = False

        .DisplayContextTooltips = True

        .ShowDrillIndicators = True

        .PrintDrillIndicators = False

        .AllowMultipleFilters = False

        .SortUsingCustomLists = True

        .FieldListSortAscending = False

        .ShowValuesRow = False

        .CalculatedMembersInFilters = False

        .RowAxisLayout xlCompactRow

    End With

    With ActiveSheet.PivotTables("ピボットテーブル1").PivotCache

        .RefreshOnFileOpen = False

        .MissingItemsLimit = xlMissingItemsDefault

    End With

    ActiveSheet.PivotTables("ピボットテーブル1").RepeatAllLabels xlRepeatLabels

    ActiveWorkbook.ShowPivotTableFieldList = True

    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("病院名薬局名")

        .Orientation = xlRowField

        .Position = 1

    End With

    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("日付")

        .Orientation = xlRowField

        .Position = 2

    End With

    ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("日付").AutoGroup

    ActiveSheet.PivotTables("ピボットテーブル1").AddDataField ActiveSheet.PivotTables( _

        "ピボットテーブル1").PivotFields("金額"), "合計 / 金額", xlSum

    With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("備考")

        .Orientation = xlRowField

        .Position = 4

    End With

    ActiveWorkbook.ShowPivotTableFieldList = False

    Range("C2").Select 

End Sub


年が変わると新しくファイルを作らなくてはならないが

オイラのマクロ能力はここまでです。

本当はファイルは一つで年が変わっていったらシートを増やす方法でやりたかったが

難しい。

0 件のコメント:

コメントを投稿

海外(タイ)から楽天市場で購入が面倒くさい状態です。

楽天の期間限定ポイントが11月20日に切れるのがあったので 楽天市場で買い物をすることにした。 日本にいれば街のお店で使えるのだが 日本不在ではそれができないので楽天市場で買い物をすることにした。 日本に行くまでの期間にポイントが切れるのが760ポイントあるので それを処理するこ...