簿記とエクセル：録太の新生活 12
◎自動作成の試み３
損益型のブックを生成します。
Sub makePLstart() ' 新しいブックを生成して、損益系のシートをつくる'
Dim cnt As Integer
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & myplname
For cnt = 1 To 5
If cnt = 1 Then
sname = soneki4 ' "その他"'
k_code = 25
End If
If cnt = 2 Then
sname = soneki3 ' "勉学交際"'
k_code = 24
End If
If cnt = 3 Then
sname = soneki2 ' "日用品"'
k_code = 23
End If
If cnt = 4 Then
sname = soneki1 ' "食費"'
k_code = 22
End If
If cnt = 5 Then
sname = sonekir1 ' "収入"'
k_code = 21
End If
Workbooks(myplname).Activate
ActiveWorkbook.Worksheets.Add before:=Worksheets(1)
ActiveSheet.Name = sname
retuMake k_code
inputStr sname, k_code
Next cnt
ActiveWorkbook.Save
Worksheets(1).Activate
Cells(1, 1).Select
End Sub
各科目のシートを生成します。
Sub retuMakePL() ' 期首 4月 4月残高
'セル幅を設定する 科目 空 借方 貸方 借方 貸方 借方 貸方 空 空 空 空 空 空 空 空
' 12.38 2 9.38 9.38 9.38 9.38 9.38 9.38 2 2 2 2 2 2 2 2
Dim i As Integer
Dim ii As Integer
Dim tuki As Integer
Dim t_kara As Integer
Dim t_kamoku As Integer
Dim t_kari As Integer
Dim t_kashi As Integer
Dim t_zankari As Integer
Dim t_zankashi As Integer
Dim thisretu As Integer
Dim sisanretu As Integer
Dim sonekiretu As Integer
Dim souretu As Integer
Dim kari_retustrk As String
Dim kashi_retustrk As String
Dim souretu_strk As String
Dim kariretu_str As String
Dim kashiretu_str As String
Dim souretu_str As String
Dim tobi As Integer
Dim r_yobi As Integer
Dim nretu As Integer
t_kamoku = 12.38
t_kara = 2
t_kari = 9.38
t_kashi = 9.38
t_zankari = 9.38
t_zankashi = 9.38
tobi = 9
nretu = 5 ' 3桁コンマ区切り用'
Columns(1).ColumnWidth = t_kamoku
Columns(2).ColumnWidth = t_kara
Columns(3).ColumnWidth = t_kari
Columns(4).ColumnWidth = t_kashi
Cells(2, 1).Value = "科目"
Cells(2, 3).Value = "借方"
Cells(2, 4).Value = "貸方"
Cells(3, 1).Value = sisan1 ' "現金"'
Cells(4, 1).Value = sisan2 ' "家具類"'
Cells(5, 1).Value = sisan3 ' "家電類"'
Cells(6, 1).Value = sisan4 ' "衣料類"'
Cells(7, 1).Value = sisanr1 ' "クレジット" '
Cells(8, 1).Value = "" '予備
Cells(9, 1).Value = "" '予備
Cells(10, 1).Value = "" '予備
Cells(11, 1).Value = "" '予備
Cells(12, 1).Value = "" '予備
Cells(13, 1).Value = "資産計" '
Cells(14, 1).Value = "" '
Cells(15, 1).Value = sonekir1 ' "収入"'
Cells(16, 1).Value = soneki1 ' "食費"'
Cells(17, 1).Value = soneki2 ' "日用品" '
Cells(18, 1).Value = soneki3 ' "勉学交際"'
Cells(19, 1).Value = soneki4 ' "その他" '
Cells(20, 1).Value = "" '予備
Cells(21, 1).Value = ""
Cells(22, 1).Value = ""
Cells(23, 1).Value = ""
Cells(24, 1).Value = ""
Cells(25, 1).Value = ""
Cells(26, 1).Value = ""
Cells(27, 1).Value = ""
Cells(28, 1).Value = ""
Cells(29, 1).Value = "損益計"
Cells(30, 1).Value = "資産損益合計"
Range(Cells(1, 3), Cells(1, 4)).MergeCells = True
Range(Cells(1, 3), Cells(1, 4)).Value = "期 首"
Cells(13, 3).Value = "=sum(C3:C12)" ' 資産項目と損益項目の集計'
Cells(29, 3).Value = "=sum(C15:C28)" '
Cells(30, 3).Value = "=sum(C13+C29)" '
Cells(13, 4).Value = "=sum(D3:D12)" '
Cells(29, 4).Value = "=sum(D15:D28)" '
Cells(30, 4).Value = "=sum(D13+D29)" '
For i = 5 To 140 Step 12 ' 月ごと：当月と当月残と余白８つ'
ii = ii + 1
If ii < 10 Then ' >'
tuki = ii
Else
tuki = ii
End If
Columns(i).ColumnWidth = t_kari
Columns(i + 1).ColumnWidth = t_kashi
Columns(i + 2).ColumnWidth = t_zankari
Columns(i + 3).ColumnWidth = t_zankashi
Columns(i + 4).ColumnWidth = t_kara
Columns(i + 5).ColumnWidth = t_kara
Columns(i + 6).ColumnWidth = t_kara
Columns(i + 7).ColumnWidth = t_kara
Columns(i + 8).ColumnWidth = t_kara
Columns(i + 9).ColumnWidth = t_kara
Columns(i + 10).ColumnWidth = t_kara
Columns(i + 11).ColumnWidth = t_kara
Range(Cells(1, i), Cells(1, i + 1)).MergeCells = True
Range(Cells(1, i), Cells(1, i + 1)).Value = tuki & " 月"
Range(Cells(1, i + 2), Cells(1, i + 3)).MergeCells = True
Range(Cells(1, i + 2), Cells(1, i + 3)).Value = tuki & " 月残高"
Cells(2, i).Value = "借方"
Cells(2, i + 1).Value = "貸方"
Cells(2, i + 2).Value = "借方"
Cells(2, i + 3).Value = "貸方"
Cells(13, i).FormulaR1C1 = "=sum(R[-10]C:R[-1]C)" ' 資産項目と損益項目の集計"
Cells(29, i).FormulaR1C1 = "=sum(R[-14]C:R[-1]C)"
Cells(30, i).FormulaR1C1 = "=sum(R[-17]C+R[-1]C)"
Cells(13, i + 1).FormulaR1C1 = "=sum(R[-10]C:R[-1]C)" ' 資産計
Cells(29, i + 1).FormulaR1C1 = "=sum(R[-14]C:R[-1]C)" ' 損益計
Cells(30, i + 1).FormulaR1C1 = "=sum(R[-17]C+R[-1]C)" ' 資産損益合計
Cells(13, i + 2).FormulaR1C1 = "=sum(R[-10]C:R[-1]C)" '
Cells(29, i + 2).FormulaR1C1 = "=sum(R[-14]C:R[-1]C)" '
Cells(30, i + 2).FormulaR1C1 = "=sum(R[-17]C+R[-1]C)" '
Cells(13, i + 3).FormulaR1C1 = "=sum(R[-10]C:R[-1]C)" '
Cells(29, i + 3).FormulaR1C1 = "=sum(R[-14]C:R[-1]C)" '
Cells(30, i + 3).FormulaR1C1 = "=sum(R[-17]C+R[-1]C)" '
Next i
maituki
zandaka
Rows("1:2").HorizontalAlignment = xlCenter
ActiveWorkbook.Save
Cells(1, 1).Select
End Sub
月次合計のシートを生成します。
Sub maituki()
Dim g As Integer
Dim r As Integer
Workbooks(myplname).Activate
Worksheets("月次合計").Activate
For r = 5 To 144 Step 12
For g = 3 To 19
If g = 3 Then ' 現金〜衣料
Cells(g, r).Value = "=[" & mybname & "]" & sisan1 & "!R2C" & r ' 現金：借方
Cells(g, r + 1).Value = "=[" & mybname & "]" & sisan1 & "!R2C" & r + 1 ' 現金：貸方
ElseIf g = 4 Then '
Cells(g, r).Value = "=[" & mybname & "]" & sisan2 & "!R2C" & r ' 家具類
ElseIf g = 5 Then '
Cells(g, r).Value = "=[" & mybname & "]" & sisan3 & "!R2C" & r ' 家電類
ElseIf g = 6 Then '
Cells(g, r).Value = "=[" & mybname & "]" & sisan4 & "!R2C" & r ' 衣料類
ElseIf g = 7 Then ' 借入
Cells(g, r).Value = "=[" & mybname & "]" & sisanr1 & "!R2C" & r ' クレジット：借入
Cells(g, r + 1).Value = "=[" & mybname & "]" & sisanr1 & "!R2C" & r + 1 ' クレジット：借入
ElseIf g = 15 Then ' 収入
Cells(g, r + 1).Value = "=" & sonekir1 & "!R2C" & r + 1 ' 収入
ElseIf g = 16 Then '
Cells(g, r).Value = "=" & soneki1 & "!R2C" & r ' 食費
ElseIf g = 17 Then '
Cells(g, r).Value = "=" & soneki2 & "!R2C" & r ' 日用品
ElseIf g = 18 Then '
Cells(g, r).Value = "=" & soneki3 & "!R2C" & r ' 勉学交際
ElseIf g = 19 Then '
Cells(g, r).Value = "=" & soneki4 & "!R2C" & r ' その他
End If
Next g
Next r
Range("a1:ej30").NumberFormatLocal = "#,##0_ "
End Sub
1月から順に月次残高の数式を入れていきます。
Sub zandaka()
Dim g As Integer
Dim r As Integer
For r = 7 To 140 Step 12
For g = 3 To 19
If r = 7 Then
If g > 2 And g < 7 Then ' >現金〜'
Cells(g, r).FormulaR1C1 = "=RC[-4]+RC[-2]-RC[-1]"
Cells(g, r + 1).Value = ""
ElseIf g > 7 And g < 15 Then ' >空白'
'Cells(g, r).Value = ""
'Cells(g, r+1).FormulaR1C1 = "=sum(RC[]+RC[]-RC[])"
ElseIf g = 7 Or g = 15 Then ' 借入または収入'
Cells(g, r).Value = ""
Cells(g, r + 1).FormulaR1C1 = "=RC[-4]-RC[-3]+RC[-2]"
Else
Cells(g, r).FormulaR1C1 = "=RC[-4]+RC[-2]-RC[-1]"
Cells(g, r + 1).Value = ""
End If
Else
If g > 2 And g < 7 Then ' >現金〜衣料'
Cells(g, r).FormulaR1C1 = "=RC[-12]+RC[-2]-RC[-1]"
Cells(g, r + 1).Value = ""
ElseIf g > 7 And g < 15 Then ' >空白'
'Cells(g, r).Value = ""
'Cells(g, r+1).FormulaR1C1 = "=sum(RC[]+RC[]-RC[])"
ElseIf g = 7 Or g = 15 Then ' 借入＆収入'
Cells(g, r).Value = ""
Cells(g, r + 1).FormulaR1C1 = "=RC[-12]-RC[-3]+RC[-2]"
Else
Cells(g, r).FormulaR1C1 = "=RC[-12]+RC[-2]-RC[-1]"
Cells(g, r + 1).Value = ""
End If
End If ' 1月のみ計算は期首から開始'
Next g
Next r
End Sub
この企画の目標は、「家計簿をエクセルで実現しながら簿記を知ることができる」です。
簿記とエクセルのトップページへ戻る
Home へ戻る