Excelで作成した家賃集計表から会計データを作成するマクロを考えてみた件。

2022年3月20日2022年4月1日

Excelで作成した家賃集計表をもとに会計ソフトへ仕訳をインポートする元となるデータを作成するマクロを考えてみました。

家賃集計表から仕訳データを作成するマクロの概要
家賃集計表から仕訳データを作成するマクロ
1年の途中で入居や退去があった場合に対応するために少し改良
まとめ

家賃集計表から仕訳データを作成するマクロの概要

今回作成した家賃集計表は下記のようなものになります。

表の一番左から

物件名（入居者名）
毎月の家賃金額
各月の家賃の入金日

を記載する欄を設けています。

物件名には借主の名前を入力し、契約している家賃の金額を入力します。物件名の部分は後ほど仕訳データの「摘要」として使用することにしています。

あとは家賃が入金された「日付」をセルに入力することで、入金された日付けで仕訳のデータを作成するようにしています。

また、勘定科目に関しては下記の部分に仕訳データで使用したい勘定科目を設定します↓

あとはマクロの実行ボタンを押すと仕訳データが作成されます。

実行するとこんな感じで動作します↓

借方勘定科目や貸方勘定科目を変更した場合には当然、変更後の勘定科目で仕訳データの作成が行われますのでそちらも確認していただければと思います。

家賃集計表から仕訳データを作成するマクロ

今回作成したマクロは下記になります↓

Sub yatin()
 
'■変数宣言
 
Dim i As Long
Dim j As Long
Dim lastrow As Long
 
Dim kingaku As Long
Dim karikata As String
Dim kasikata As String
 
karikata = Range("d2").Value
kasikata = Range("g2").Value
lastrow = Cells(Rows.Count, 2).End(xlUp).Row + 1
 
'■処理実行部分
 
For i = 6 To Range("b6").End(xlDown).Row
     
    kingaku = Range("c" & i).Value  '家賃金額の定義
 
    For j = 4 To 15
     
        Range("b" & lastrow).Value = Cells(i, j).Value
        Range("c" & lastrow).Value = karikata
        Range("d" & lastrow).Value = kingaku
        Range("e" & lastrow).Value = kasikata
        Range("f" & lastrow).Value = kingaku
        Range("g" & lastrow).Value = Range("b" & i) & "　" & Cells(5, j)
     
        lastrow = lastrow + 1 '最終データ行の再取得
     
    Next j
     
Next i
 
MsgBox "done"
 
End Sub

処理速度を上げるのであれば配列を使用してマクロを作成すると処理速度があがると思いますが、この程度の量であれば別にいいかなと思い、力技でマクロを作成しています。

1年の途中で入居や退去があった場合に対応するために少し改良

上記のマクロですが、1年間の途中で新たに入居や退去があった場合、つまり1年間を通して家賃収入がなかった場合でも問題なく仕訳データの作成が可能です。

たとえばこんな感じで1年の途中で入居や退去があった場合のデータを用意します↓

この状態でマクロを実行するとこんな感じになります↓

入金日が記載されていないセルに関しても仕訳データを作成するようにマクロが動作しているのが確認できます。

日付の列（B列）を確認して、空白になっているデータに関しては必要のないデータになるので、この空白のデータを削除するマクロを追加すれば1年の途中で入居や退去があっても問題なく仕訳データを作成することができそうです。

ということで上記のマクロに2行ほどコードを追加します↓

Sub yatin()
 
'■変数宣言
 
Dim i As Long
Dim j As Long
Dim lastrow As Long
 
Dim kingaku As Long
Dim karikata As String
Dim kasikata As String
 
karikata = Range("d2").Value
kasikata = Range("g2").Value
lastrow = Cells(Rows.Count, 2).End(xlUp).Row + 1
 
'■処理実行部分
 
For i = 6 To Range("b6").End(xlDown).Row
     
    kingaku = Range("c" & i).Value  '家賃金額の定義
 
    For j = 4 To 15
     
        Range("b" & lastrow).Value = Cells(i, j).Value
        Range("c" & lastrow).Value = karikata
        Range("d" & lastrow).Value = kingaku
        Range("e" & lastrow).Value = kasikata
        Range("f" & lastrow).Value = kingaku
        Range("g" & lastrow).Value = Range("b" & i) & "　" & Cells(5, j)
     
        lastrow = lastrow + 1 '最終データ行の再取得
     
    Next j
 
Next i
 
MsgBox "done"
 
On Error Resume Next　'エラーがあった場合に無視する（空白のデータがない場合）
Range("B14").CurrentRegion.SpecialCells(xlCellTypeBlanks).EntireRow.Delete　'空白行の削除
 
End Sub