勘定科目ごとにシートを作成するマクロ
この記事では勘定科目ごとにシートを作成するマクロをプログラムしていきます。
シートをコピーするだけですので、非常に簡単です。
マクロの内容一覧
- 今回作成するシートが重複していないかチェック
- シートをコピーして末尾に貼り付け
- 1Aセルの値をシート名と合わせる
- テーブル名の変更
となっています。基本的にマクロの記録の値を修正しながら作成しますので、処理速度は少し遅いです。しかし、大した処理量ではないので一瞬で終わります。
マクロを記録していきましょう
まず、マクロを記録
手順を説明します。
シート総勘定元帳を右クリックして、【移動またはコピー】を選択します。
【末尾に移動】を選択し、【コピーを作成する】にチェックを入れ、【OK】をクリックします。
次にA1セルを選択し、「現金」と入力します。
次に総勘定元帳（２）シート名を「現金」に修正します。
次にテーブル名を「現金」に修正します。
マクロの記録を終了します。
するとVBAのコードを記述する箇所が下記のようになったと思います。
現在は非常に見づらい状態になっていますので、取り合えず、整頓していきます。
ここからはVBAの画面のみを使用していきますので、コードのみ貼り付けていきます。
以下のコードの赤色の部分を削除していきます。
Sub 勘定科目シートの作成()
'
' 勘定科目シートの作成 Macro
'
Sheets("総勘定元帳").Select
Sheets("総勘定元帳").Copy After:=Sheets(3)
Range("A1").Select
ActiveCell.FormulaR1C1 = "現金"
ActiveCell.Characters(1, 0).PhoneticCharacters = "ゲンキン"
Range("C31").Select
Sheets("総勘定元帳 (2)").Select
Sheets("総勘定元帳 (2)").Name = "現金"
Range("仕訳帳_56[#All]").Select
ActiveSheet.ListObjects("仕訳帳_56").Name = "現金"
End Sub上記のコードを削除したのが下記のコードです。
Sub 勘定科目シートの作成()
'
' 勘定科目シートの作成 Macro
'
Sheets("総勘定元帳").Copy After:=Sheets(3)
Range("A1").FormulaR1C1 = "現金"
Sheets("総勘定元帳 (2)").Name = "現金"
ActiveSheet.ListObjects("仕訳帳_56").Name = "現金"
End Subとてもすっきりしました。
ですが、このマクロを実行しても全然役に立ちません笑
問題点は以下の6つです
- 何回も現金というシートが作成される（エラーになる）
- 何回もA1セルに現金と入力される。
- 何回もテーブル名が現金になる。（エラーになる）
- 同じシートの名前が存在しているので、エラーが発生します。
- シートの場所が左から３つ目の後ろにシートが作成されます。（こっちの方がいい場合はそのままでOKです）
- 仕訳帳_56は毎回変わりますので、エラーが発生します。
ということで次は問題点を修正していきます。
問題点の修正、コード改修
何回も同じシートが作成される。
問題となるコードは
Sub 勘定科目シートの作成()
'
' 勘定科目シートの作成 Macro
'
Sheets("総勘定元帳").Copy After:=Sheets(3)
Range("A1").FormulaR1C1 = "現金"
Sheets("総勘定元帳 (2)").Name = "現金"//今回はここのコードが問題です。
ActiveSheet.ListObjects("仕訳帳_56").Name = "現金"
End Sub今回は7行目のコードが問題です。
この問題を解消するには、 現金と記述している部分を自由に変更できるようにすればOKです
ということで、下記の処理が必要です。
- 新しい勘定科目名を入れる変数を作成する。
- 新しい勘定科目名を入力するInputBoxを作成する。
- 「現金」の部分を新しい勘定科目名をいれた変数に書き換える
です。
では一つずつ作成していきます。
新しい勘定科目名を入れる変数を作成する。
下記のコードを5行目に追加してください。
Dim 勘定科目 As Stringこのコードは「勘定科目」という文字を格納する変数を作成します！という意味です。
終わりです。
新しい勘定科目名を入力するInputBoxを作成する。
上記の項目で作成した変数「勘定科目」にInputBoxで入力してもらったデータを格納していきます。
下記のコードを６行目に追加してください。
勘定科目 = InputBox("新しい勘定科目を入力して下さい")これで、好きな名前でシート名や題名、テーブル名を変更する準備が整っちゃいました。一石二鳥ですね笑
「現金」の部分を新しい勘定科目名をいれた変数に書き換える。
次に「”現金”」と書かれている部分をすべて「勘定科目」に修正してください
【現金】を【勘定科目】に修正するのではなく、
注意事項
【”現金”】を【勘定科目】に修正してください。
修正すると以下のようになります。
Sub 勘定科目シートの作成()
'
' 勘定科目シートの作成 Macro
'
Dim 勘定科目 As String
勘定科目 = InputBox("新しい勘定科目を入力して下さい")
Sheets("総勘定元帳").Copy After:=Sheets(3)
Range("A1").FormulaR1C1 = 勘定科目
Sheets("総勘定元帳 (2)").Name = 勘定科目
ActiveSheet.ListObjects("仕訳帳_57").Name = 勘定科目
End Sub何回もA1セルに同じ値が入力される。
これは実は一つ前の項目で解決されています。
A1セルに現金と入力される処理がされているのは９行目です。
このように変数を設定してプログラムを作成していると同じような処理に使いまわすことができるので、非常に使い勝手がいいです。ほかにも配列等もあるので、ぜひ活用して下さい。
一応今のコードを乗せておきます。
Sub 勘定科目シートの作成()
'
' 勘定科目シートの作成 Macro
'
Dim 勘定科目 As String
勘定科目 = InputBox("新しい勘定科目を入力して下さい")
Sheets("総勘定元帳").Copy After:=Sheets(3)
Range("A1").FormulaR1C1 = 勘定科目
Sheets("総勘定元帳 (2)").Name = 勘定科目
ActiveSheet.ListObjects("仕訳帳_57").Name = 勘定科目
End Subテーブル名を変更しようとするとエラーになる。
これはテーブル名が存在しないものを指定しているからです。
テーブル名を取得するのは、大変なので今回は一番最後に作成したテーブルの名前を変更する。
という形で実装していきたいと思います。
「”仕訳帳_57″」と書かれている部分を「ActiveSheet.ListObjects.Count」に変更します。
変更した後のコードが下記になります。
Sub 勘定科目シートの作成()
'
' 勘定科目シートの作成 Macro
'
Dim 勘定科目 As String
勘定科目 = InputBox("新しい勘定科目を入力して下さい")
Sheets("総勘定元帳").Copy After:=Sheets(3)
Range("A1").FormulaR1C1 = 勘定科目
Sheets("総勘定元帳 (2)").Name = 勘定科目
ActiveSheet.ListObjects(ActiveSheet.ListObjects.Count).Name = 勘定科目 'ここを変更しています
End Sub
これで実行できるようになりました。ちゃんと実行できるか確かめてみてください。
僕は勘定科目が思いつかなかったので、「鼻毛伸びてきたぁ」にしました。笑
実行するとこのような感じになりました。
みなさんはデータベースシートにある勘定科目を使用して点検してみてください笑
しかし、すでに存在しているシートの名前をInputBoxに入力してしまうとエラーが表示されて終了してしまいます。
次はこのエラーが発生しないように修正していきます。
同じシートが存在しているとエラーになる。
これは入力した勘定科目のシートが存在するかどうかをチェックして存在する場合は作成せずにマクロを終了させるコードを記述します。
このコードは下記の手順で記述していきます。
- あるシートでInputBoxに入力した勘定科目名と一致するかどうかをチェックする。
- あった場合：マクロを終了する。
- なかった場合：マクロを続行する。
- 上記のチェックをすべてのシートで実行する。
では記述していきます。
あるシート名がInputBoxに入力した勘定科目名と一致するかどうかをチェックする。
チェックはif文を使います
if 条件式 Then
ここにいろいろ記述します。
End ifこのように記述していきます。
また、シート名は下記のように記述することで取得できます
Sheets(1).Name 'シートの左から1つ目のシート名を指定しています。この二つの文を組み合わせて下記のコードをInputBoxの下に記述していきます
If Sheets(1).Name = 勘定科目 Then
MsgBox "同じ勘定科目のシートが存在しているため、終了します"
Exit Sub 'マクロを終了させるコード
End If下記のコードが追加した後のコードです。
Sub 勘定科目シートの作成()
'
' 勘定科目シートの作成 Macro
'
Dim 勘定科目 As String
勘定科目 = InputBox("新しい勘定科目を入力して下さい")
If Sheets(1).Name = 勘定科目 Then
MsgBox "同じ勘定科目のシートが存在しているため、終了します"
Exit Sub 'マクロを終了させるコード
End If
Sheets("総勘定元帳").Copy After:=Sheets(3)
Range("A1").FormulaR1C1 = 勘定科目
Sheets("総勘定元帳 (2)").Name = 勘定科目
ActiveSheet.ListObjects(ActiveSheet.ListObjects.Count).Name = 勘定科目 'ここを変更しています
End Sub
これでとりあえず、InputBoxに「仕訳帳」と入力したらメッセージを表示した後に終了します。
「仕訳帳」以外のコードでは処理が実行されてしまいますので、次の項目ですべてのシートをチェックしていきます。
上記のチェックをすべてのシートで実行する。
繰り返し文とはfor文といわれています。
VBAの繰り返し文は下記のように記述します。
for i = 1 to シートの数
この行はいろいろコードを記述します。
next i「シートの数」の部分は勘定科目が増えれば増えるほど多くなっていきますので、関数というものを使って取得していきます。
シート数を取得する関数は下記のコードです。
Sheets.Count先ほどの項目で作成したシート名のチェックをこのコードを使って繰り返します。
For i = 1 To Sheets.Count
If Sheets(i).Name = 勘定科目 Then '(i)の部分が１から順番に増えていきます。
MsgBox "同じ勘定科目のシートが存在しているため、終了します"
Exit Sub
End If
Next iこれですべてのシートでInputBoxに入力した値のシートが存在するかをチェックしてくれます。
転記した後のコードが下記のコードです。
Sub 勘定科目シートの作成()
'
' 勘定科目シートの作成 Macro
'
Dim 勘定科目 As String
勘定科目 = InputBox("新しい勘定科目を入力して下さい")
For i = 1 To Sheets.Count
If Sheets(i).Name = 勘定科目 Then
MsgBox "同じ勘定科目のシートが存在しているため、終了します"
Exit Sub
End If
Next i
Sheets("総勘定元帳").Copy After:=Sheets(3)
Range("A1").FormulaR1C1 = 勘定科目
Sheets("総勘定元帳 (2)").Name = 勘定科目
ActiveSheet.ListObjects(ActiveSheet.ListObjects.Count).Name = 勘定科目
End Subこれで概ね完成です。
正確にはキャンセルボタンを押しても実行されてしまいますので、完成とは言えませんが、形としては出来上がっているので勘定科目のシート作成するマクロはここまでで終了します。
次はマクロを実行するコードをデータベースのシートに設置して終了です。
マクロを実行するボタンを設置する。
マクロを実行するボタンは開発タブの挿入から設置できます。
データベースのシートに好きなボタンの大きさに選択して、マクロ名「勘定科目シートの作成」を選択してOKを押してください。
自分はこんな感じでボタンを設置してみました。
次回は貸方科目や貸方金額を勘定科目ごとに転記するマクロを作成していきます。
結構長くなってしまいました。
読んでいただきありがとうございます。
コメント