キーボードマクロで作った「月別コピー」は、やはり機能が限定的ですので、コードを書き換えます。
1.このマクロは、「出金記録」Sheetが選択されている事が前提で記述されていますので、「sheet2」が選択されている状態で実行しますと、具合がわるいことになります。そこで実行時に必ず「出金記録」が選択されるように次の1行を始めに追加します。
--ここから
Worksheets("出金記録").Select
--ここまで
2.[日付抽出]マクロと同じ様に、抽出したい日付を入力できる様にします。
今回は、入力した日付が、日付データとして認識されないような場合には正常に絞り込みが行なわれませんので、入力した文字列が日付データでは無い場合は、やり直しをするようにしました。
--ここから
日付1$ = InputBox("日付範囲の先頭の年月日を入力してください" + vbCrLf + "yyyy/mm/dd",
"日付範囲記入") If IsDate(日付1$) = False Then MsgBox "日付データではありません、やり直してください", 0, "確認" Exit Sub End If 日付2$ = InputBox("日付範囲の最後の年月日を入力してください" + vbCrLf + "yyyy/mm/dd", "日付範囲記入") If IsDate(日付2$) = False Then MsgBox "日付データではありません、やり直してください", 0, "確認" Exit Sub End If Selection.AutoFilter Range("A1").Select Selection.AutoFilter Field:=1 Selection.AutoFilter Field:=1, Criteria1:=">=" & 日付1$, Operator:=xlAnd, _ Criteria2:="<=" & 日付2$ |
--ここまで
3.スクリーンリーダーはクリップボードにコピーされたデータを読み上げます。
データが大きいと時間がかかり遅くなりますので、次の1行を書いて、クリップボードに空白Cellをコピーして、読み上げを短くします。
--ここから
Range("Z1").copy
--ここまで
4.Cellに文字や数式を入力するところですが、少し複雑な記述になっていますので、[=]を使って代入する式に書き換えます。
--ここから
Range("E1") = "合計"
Range("F1") = "残高"
Range("G1") = "今月の予算額は"
Range("E2") = "=SUM($D$2:$D2)"
Range("F2") = "=IF($H$1<>"""",$H$1-$E2,"""")
--ここまで
5.計算式をコピーする範囲ですが、最初のマクロでは行番号を固定していましたが、抽出したデータによってコピーする行数が異なりますので、行番号の最大値を取得します。
データの記入されている最下段の行番号を取得するには、通常次の式を使います。
R%と言うのは、取得した行番号を入れる変数です。
また計算式をコピーしたあとに、金額の列はカンマ区切りの書式設定を行います。
--ここから
R% = ActiveSheet.Range("$A$65536").End(xlUp).row
Range(Cells(2,5),Cells(R%,5)).select
Selection.FillDown
Range(Cells(2,6),Cells(R%,6)).select
Selection.FillDown
Range(Cells(2,4),Cells(R%,6)).select
Selection.NumberFormatLocal = "#,##0_ "
--ここまで
6.マクロの速度を向上させるため、画面が動かないようにします。
後の方の、「オートフィルタ」のチェックを外すのにかなりの時間がかかるようなので、下のコードを追加して、動作を早くします。
--ここから
Dim xlAPP As Application
Set xlAPP = Application
With xlAPP
.ScreenUpdating = False
.Cursor = xlWait
End With
ここにコードが記録されています。
With xlAPP
.ScreenUpdating = True
.Cursor = xlDefault
End With
--ここまで
以下は訂正した[月別コピー]です。Module2.basを変更して下さい。
--ここから
Sub 月別コピー() ' ' 月別コピー Macro ' マクロ記録日 : 2008/5/13 ユーザー名 : masana ' ActiveWorkBook.Worksheets("出金記録").select ActiveSheet.Next.Select Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Clear ActiveSheet.Previous.Select 日付1$ = InputBox("日付範囲の先頭の年月日を入力してください" + vbCrLf + "yyyy/mm/dd", "日付範囲記入") If IsDate(日付1$) = False Then MsgBox "日付データではありません、やり直してください", 0, "確認" Exit Sub End If 日付2$ = InputBox("日付範囲の最後の年月日を入力してください" + vbCrLf + "yyyy/mm/dd", "日付範囲記入") If IsDate(日付2$) = False Then MsgBox "日付データではありません、やり直してください", 0, "確認" Exit Sub End If Dim xlAPP As Application Set xlAPP = Application With xlAPP .ScreenUpdating = False .Cursor = xlWait End With Selection.AutoFilter Range("A1").Select Selection.AutoFilter Field:=1 Selection.AutoFilter Field:=1, Criteria1:=">=" & 日付1$, Operator:=xlAnd, _ Criteria2:="<=" & 日付2$ Range("A1").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy ActiveSheet.Next.Select Range("A1").Select ActiveSheet.Paste 'スクリーンリーダーの音を短くする。 Range("Z1").copy Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Columns.AutoFit Range("E1") = "合計" Range("F1") = "残高" Range("G1") = "今月の予算額は" Range("E2") = "=SUM($D$2:$D2)" Range("F2") = "=IF($H$1<>"""",$H$1-$E2,"""") xlAPP.CutCopyMode = False R% = ActiveSheet.Range("$A$65536").End(xlUp).row Range(Cells(2,5),Cells(R%,5)).select Selection.FillDown Range(Cells(2,6),Cells(R%,6)).select Selection.FillDown Range(Cells(2,4),Cells(R%,6)).select Selection.NumberFormatLocal = "#,##0_ " ActiveSheet.Previous.Select Selection.AutoFilter ActiveSheet.Next.Select Range("A1").Select With xlAPP .ScreenUpdating = True .Cursor = xlDefault End With End Sub |
--ここまで。
少しマクロらしくなりましたね。
変更した「Module2.bas」を保存します。
「Visual Basic Editor」を開き、「Module2.bas」を組み込みます。
手順は前を参照して下さい。
[ショートカットが無いマクロの実行]
1.[Alt+T]キーを押してメニューバーの「ツール(T)」のプルダウンメニューを出します。
2.[M]キーを押すか[上下カーソル]キーで「マクロ(M)」を選択します。
3.サブメニューの「マクロ(M)]を選択して[Enter]キーを押します。([Alt,T,M,M]キーです)。
4.[Tab]キーを1度押しますと、現在組み込まれているマクロの一覧が選択されますので、[上下カーソル]キーで選択して[Enter]キーを押します。今回は「月別コピー」を選択します。
マクロが実行されます。
「月別コピー」が実行されたら、Cell[H1]に今月の予算額を入力して下さい。残額欄に残高が表示されます。予算額が入力されていない時は、残高は表示されません。
この月別のSheetを取っておきたい場合は、[Sheet2]を選択して、Sheetの挿入をして下さい。
「出金記録」と「Sheet2」の間に新しいSheetが入り、この「月別コピーマクロを実行するとその新しいSheetに、マクロが実行されます。
「Sheet2」の名前を「4月」などに変更しますと、毎月の出金の記録が保存されていきます。