簿記とエクセル:録太の新生活 12


◎自動作成の試み3

損益型のブックを生成します。

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             ' 月ごと:当月と当月残と余白8つ'
        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 へ戻る

ピヨ
中小企業診断士受験のサイト
…… 運営者:TEAM(This is every accessible meeting.) Copyright 2022 ……