借方科目、借方金額等を総勘定元帳へ転記するマクロ

この記事は仕訳帳の借方科目、借方金額等を総勘定元帳（勘定科目ごとのシート）へ振り分けるマクロを作成します。
かなりの記述量になると思いますので、休憩をはさみながら読んでいただけたらと思います。

今回作成するマクロの構成
１，各勘定科目テーブルの初期化（値の全削除）を行う
２，仕訳帳のある行の借方勘定科目のシートのテーブルに転記する
３，仕訳帳のある行の貸方勘定科目のシートのテーブルに転記する
初期化関数の呼び出し
完成！
1. 関連

今回作成するマクロの構成

各勘定科目テーブルの初期化（値の全削除）を行う
仕訳帳のある行の借方勘定科目のシートのテーブルに転記する
転記するのは年月日、貸方科目、借方金額、摘要の４つとします。
仕訳帳のある行の貸方勘定科目のシートのテーブルに転記する
転記するのは年月日、借方科目、借方金額、摘要の４つとします。
１，２を仕訳帳の最終行まで繰り返す。

１，各勘定科目テーブルの初期化（値の全削除）を行う

テーブルの初期化は同じ日付の仕訳を２重入力するのを防ぐために作成します。
一旦テーブルの中身はすべて消して、新たにすべて転記していくという流れです。
仕訳帳の量が多くなればなるほど処理に時間がかかってしまいますが、コードをシンプルにする為、今回はこの手段で行きます。

また、ちゃんと転記作業のプログラムが実行されているか点検するときにテーブルに何か入っていたら、変化がわからないため、各テーブルの初期化は別のマクロとして作成していきます。

見出し行以外のデータをすべて消すため、以下の２個のコードを使用します。

Sheets.Count ' シートの総数を返します
Sheets.ListObject.DataBodyRange 'テーブルの見出しセル以外を表します。

また、テーブル名を指定しなければなりません。
シート名とテーブル名を同じにしているので、シート名を取得して変数に入れておきます。

下記のコードが完成したコードです。

Sub 勘定科目テーブルの初期化()
    Dim シート名 As String
    
    For i = 4 To Sheets.Count
        シート名 = Sheets(i).Name
        If Sheets(i).ListObjects(シート名).ListRows.Count <> 0 Then
            Sheets(i).ListObjects(シート名).DataBodyRange.Delete
        End If
    Next i
End Sub

すべての勘定科目のシートでテーブルの削除を繰り返すため、for文を使用しています。

テーブルに何か適当な文字を打ったあとに実行してみてください。
テーブルが見出しだけになると思います。

２，仕訳帳のある行の借方勘定科目のシートのテーブルに転記する

この項目は下記の手順で作成します。

変数の宣言
仕訳帳の最終行の取得
仕訳帳の任意の行のデータ一括取得
借方科目の取得及び、シート及びテーブル指定
仕訳帳の任意の行のデータを取得した借方科目のテーブルの最終行の下に転記及び繰り返し
初期化関数の呼び出し

です。

１、変数の宣言

今回使用する変数は以下の３つです。

Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer '仕訳帳の最終行保存用
    Dim 勘定科目 As String '借方勘定科目の保存用
    Dim データ As Range '仕訳帳の任意の行のデータ保存用
End Sub

２、仕訳帳の最終行の取得

最終行の取得方法はたくさんありますが、今回はテーブルの最終行を取得していきます

Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count

ListRows.Countはテーブルの行数を返してくれます。
つまり、最終行ですね。
以下のコードが最終行取得を含んだコードです。

Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer
    Dim 勘定科目 As String
    Dim データ As Range
    
    lastrow = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count
End Sub

３、仕訳帳の任意の行のデータ一括取得

任意のデータということで、１行目のデータを取得していこうと思います。
また、取得したデータをデータというオブジェクト変数に格納していきます。

Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer
    Dim 勘定科目 As String
    Dim データ As Range
    
    lastrow = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count
    
    Set データ = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows(1).Range
End Sub

オブジェクト変数に値を格納する場合は「Set データ = Range」という形を使用します。

４、借方科目の取得及び、シート及びテーブル指定

借方科目の取得はシート名から取得します。
また、シート及びテーブル名は次の転記作業で何回も記述しなければならないため、with文を使用していきます。

Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer
    Dim 勘定科目 As String
    Dim データ As Range
    
    lastrow = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count
       Set データ = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows(1).Range
       勘定科目 = データ(1, 3).Value
       With Sheets(勘定科目).ListObjects(勘定科目)
       End With
End Sub

５、仕訳帳の任意の行のデータを取得した借方科目のテーブルの最終行の下に転記及び繰り返し

項目４で作成したwith文の中に転記するためのコードを記述していきます。
また、借方科目のテーブルの最終行は「.ListRows.Count」で取得します。
しかし、見出しが含まれているため、正確には最終行の１個手前を取得してしまいます。
ですので、２行下が最終行の下の行にあたります。
シンプルに２足します笑

Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer
    Dim 勘定科目 As String
    Dim データ As Range
    
    lastrow = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count
    
       Set データ = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows(1).Range
       勘定科目 = データ(1, 3).Value
       With Sheets(勘定科目).ListObjects(勘定科目)
            .Range(.ListRows.Count + 2, 1).Value = データ(1, 1).Value
            .Range(.ListRows.Count + 1, 2).Value = データ(1, 5).Value
            .Range(.ListRows.Count + 1, 3).Value = データ(1, 4).Value
            .Range(.ListRows.Count + 1, 6).Value = データ(1, 2).Value
       End With
End Sub

２個目の項目からは新しい行ができていますので、最終行に転記していくことになります。
ですので、+1という記述になっています。
よくわからない方は+2で実行してみてください。意味が分かると思います。

６、仕訳帳の最終行まで３，４，５の繰り返し

では仕訳帳の１行目から最終行まで繰り返すため、for文で３，４，５を囲っていきます。

また、オブジェクト変数「データ」に入っているデータを繰り返しの度に格納しなおさなければならないので、繰り返しの変数を使って変えていきます。

Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer
    Dim 勘定科目 As String
    Dim データ As Range
    
    lastrow = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count
    
    For i = 1 To lastrow
       Set データ = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows(i).Range 'ListRowsが変数に変更されています。
       勘定科目 = データ(1, 3).Value
       With Sheets(勘定科目).ListObjects(勘定科目)
            .Range(.ListRows.Count + 2, 1).Value = データ(1, 1).Value
            .Range(.ListRows.Count + 1, 2).Value = データ(1, 5).Value
            .Range(.ListRows.Count + 1, 3).Value = データ(1, 4).Value
            .Range(.ListRows.Count + 1, 6).Value = データ(1, 2).Value
       End With
    Next i
End Sub

３，仕訳帳のある行の貸方勘定科目のシートのテーブルに転記する

貸方科目の勘定科目を変数に入れて借方科目の転記内容が違うだけで、処理する内容は一緒のため、
借方科目の転記の下に入れて一気にやってしまいます。

Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer
    Dim 勘定科目 As String
    Dim データ As Range
    
    lastrow = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count
    
    For i = 1 To lastrow
       Set データ = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows(i).Range
       勘定科目 = データ(1, 3).Value
       With Sheets(勘定科目).ListObjects(勘定科目)
            .Range(.ListRows.Count + 2, 1).Value = データ(1, 1).Value
            .Range(.ListRows.Count + 1, 2).Value = データ(1, 5).Value
            .Range(.ListRows.Count + 1, 3).Value = データ(1, 4).Value
            .Range(.ListRows.Count + 1, 6).Value = データ(1, 2).Value
       End With
       勘定科目 = データ(1, 5).Value '貸方科目に変更
       With Sheets(勘定科目).ListObjects(勘定科目)
            .Range(.ListRows.Count + 2, 1).Value = データ(1, 1).Value
            .Range(.ListRows.Count + 1, 2).Value = データ(1, 3).Value
            .Range(.ListRows.Count + 1, 4).Value = データ(1, 6).Value
            .Range(.ListRows.Count + 1, 6).Value = データ(1, 2).Value
       End With
    Next i
End Sub

初期化関数の呼び出し

初期化関数は下記のコードでした。

Sub 勘定科目テーブルの初期化()
    Dim シート名 As String
    
    For i = 4 To Sheets.Count
        シート名 = Sheets(i).Name
        If Sheets(i).ListObjects(シート名).ListRows.Count <> 0 Then
            Sheets(i).ListObjects(シート名).DataBodyRange.Delete
        End If
    Next i
End Sub

「勘定科目テーブルの初期化」と記述するだけで使用することができます。

初期化関数は変数の宣言の後すぐに実行したいので、変数の宣言が終了したところに記述していきます。
初期化関数の呼び出しをして完成したコードが下記になります。

Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer
    Dim 勘定科目 As String
    Dim データ As Range
    
    勘定科目テーブルの初期化
    
    lastrow = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count
    
    For i = 1 To lastrow
       Set データ = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows(i).Range
       勘定科目 = データ(1, 3).Value
       With Sheets(勘定科目).ListObjects(勘定科目)
            .Range(.ListRows.Count + 2, 1).Value = データ(1, 1).Value
            .Range(.ListRows.Count + 1, 2).Value = データ(1, 5).Value
            .Range(.ListRows.Count + 1, 3).Value = データ(1, 4).Value
            .Range(.ListRows.Count + 1, 6).Value = データ(1, 2).Value
       End With
       勘定科目 = データ(1, 5).Value
       With Sheets(勘定科目).ListObjects(勘定科目)
            .Range(.ListRows.Count + 2, 1).Value = データ(1, 1).Value
            .Range(.ListRows.Count + 1, 2).Value = データ(1, 3).Value
            .Range(.ListRows.Count + 1, 4).Value = データ(1, 6).Value
            .Range(.ListRows.Count + 1, 6).Value = データ(1, 2).Value
       End With
    Next i
End Sub

完成！

勘定科目シートの作成マクロ及び、仕訳帳の転記マクロ、テーブル初期化マクロ
３つのマクロを作成して、仕訳帳、総勘定元帳の自動転記プログラムを作成することができました。
下記に今回作成したコードをすべて記載しておきます。

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
Sub 仕訳帳から総勘定元帳へ転記()
    Dim lastrow As Integer
    Dim 勘定科目 As String
    Dim データ As Range
    
    勘定科目テーブルの初期化
    
    lastrow = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows.Count
    
    For i = 1 To lastrow
       Set データ = Sheets("仕訳帳").ListObjects("仕訳帳").ListRows(i).Range
       勘定科目 = データ(1, 3).Value
       With Sheets(勘定科目).ListObjects(勘定科目)
            .Range(.ListRows.Count + 2, 1).Value = データ(1, 1).Value
            .Range(.ListRows.Count + 1, 2).Value = データ(1, 5).Value
            .Range(.ListRows.Count + 1, 3).Value = データ(1, 4).Value
            .Range(.ListRows.Count + 1, 6).Value = データ(1, 2).Value
       End With
       勘定科目 = データ(1, 5).Value
       With Sheets(勘定科目).ListObjects(勘定科目)
            .Range(.ListRows.Count + 2, 1).Value = データ(1, 1).Value
            .Range(.ListRows.Count + 1, 2).Value = データ(1, 3).Value
            .Range(.ListRows.Count + 1, 4).Value = データ(1, 6).Value
            .Range(.ListRows.Count + 1, 6).Value = データ(1, 2).Value
       End With
    Next i
End Sub
Sub 勘定科目テーブルの初期化()
    Dim シート名 As String
    
    For i = 4 To Sheets.Count
        シート名 = Sheets(i).Name
        If Sheets(i).ListObjects(シート名).ListRows.Count <> 0 Then
            Sheets(i).ListObjects(シート名).DataBodyRange.Delete
        End If
    Next i
End Sub

ここまで読んでくださった方ありがとうございました。
参考になれば幸いです。
今回作成した仕訳帳及び総勘定元帳のデータを添付しておきますので、このデータをもとに修正、追記等して使用してみてください。

仕訳帳ダウンロード