マクロ家計簿77/直上の行の内容をコピーするマクロを検証中‥‥

 確定申告の作成が一段落したのでデータを保存し、昨日より2017年の女房の医療費★をまとめて入力している...

  • 女房は長年 手書きの家計簿を付けているので、それを尊重。但し、医療費は、確定申告で「医療費控除」申請をするので、領収書は保存してもらうようにしている。
  • ファイル名は「医療費R★_2017.xlsx」とし、シート見出し「2017-01」に1年分を入力する。
  • 領収書は病院(医院)別になっているので、
    • 日付は、2行目のみ年月日で入力、3行目以降は Ctrl+D でコピーし、数式バーで月日を修正した。
    • 費目は全て同じになるので、Ctrl+D
    • 備考も殆ど Ctrl+D で済む。



 自分に質問してみた...

 日付を Ctrl+D でコピーしたついでに、「費目」,「カード」,「備考」もコピーできると、入力の手間が省けるのですが‥‥

  • 例えば、スーパーで焼酎とビールをカード払い買ったとします。
    • 品名は「焼酎&ビール」とし合計金額を入力していましたが、
       1行目の品名は“〇×△焼酎”、2行目は“●×▲ビール”で入力するのが簡単になります。



  • ショートカットキーによるマクロの実行ExcelAccessの学習ならOfficePro)
    ‥‥ またショートカットキーは「Ctrlキー」だけではなく「Ctrlキー+Shiftキー」と何か1つの文字という組み合わせにすることもできます。「Shiftキー」も同時に押す必要がある場合には、登録する1文字を入力する時に「Shiftキー」を押しながら文字を入力して下さい。すると次の画面の用に自動的に「Ctrl+Shift」に画面表示が変わります。

    作成済みのマクロにショートカットキーを設定する

     既に記録されたマクロに後からショートカットキーを設定したり、変更したりすることも可能です。メニューの「ツール」から「マクロ」を選択し、さらに「マクロ」をクリックして下さい。
    マクロの一覧画面が表示されますので、ショートカットキーを設定したいマクロを選択してから「オプション」ボタンをクリックして下さい。
    マクロのショートカットキーの設定と説明の編集が行える画面が表示されます。


 早速マクロ(下記)を作成し、ショートカットキーとして Ctrl+Shift+D を割り当てた。
要は日付入力時 Ctrl+D の代わりに Ctrl+Shift+D すると、「日付」「品名」「費目」「カード」「備考」をコピーするもの。


 只今、検証を兼ねて、医療費★ を1年分 入力している...

◆作成したマクロ(VBA
'カーソルが「日付」にある時、直上の行の内容をコピーする。(Ctrl+D の拡大機能)
Sub 直上のセル内容をコピーする()
Dim mbTitle As String
Dim actRow As Long, actCol As Long
Dim lastRow As Long

    mbTitle = "直上のセル内容をコピーする/" & getMacroTitle()
        '日付の最終行をセットする。
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
        'アクティブセルのアドレス
    actRow = Selection.Row
    actCol = Selection.Column
    If (actRow = 2) Or (actCol <> 2) Or (actRow <> lastRow + 1) Or (Cells(actRow, actCol) <> "") Then
        MsgBox "この機能は使えません。" & vbCrLf & vbCrLf _
                & " 1)2行目では使えません。" & vbCrLf _
                & " 2)2列目以外では使えません。" & vbCrLf _
                & " 3)直上のセルにデータが入力してある必要があります。" & vbCrLf _
                & " 4)アクティブセルは空白である必要があります。" _
                , vbCritical, mbTitle
        Exit Sub
    End If
        'Ctrl+D(同上)を行う。
    Cells(actRow, 2).FillDown   '日付
    Cells(actRow, 3).FillDown   '品名
    Cells(actRow, 4).FillDown   '費目
    Cells(actRow, 5).FillDown   'カード
    Cells(actRow, get列番号("備考")).FillDown   '備考

End Sub
'概要:引数の項目名の列番号を返す。
Function get列番号(arg項目名 As String) As Long
Dim mbTitle As String
Dim c As Long, lastColumn As Long

    mbTitle = "get列番号/" & ThisWorkbook.Name
    get列番号 = 0
    If arg項目名 = "" Then Exit Function
    
    lastColumn = Cells(1, Columns.Count).End(xlToRight).Column
    
    For c = 1 To lastColumn
        If Cells(1, c) = arg項目名 Then get列番号 = c: Exit For
    Next
    
End Function