（３）元帳

元帳を作成したい科目を選択

Private Sub UserForm_Initialize()

    Dim i As Long

    Dim lastrow As Long

    lastrow = Worksheets("科目表").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastrow

        kamokulist.AddItem Worksheets("科目表").Cells(i, 2)

    Next

End Sub

Private Sub cmdJikkou_Click()

    Worksheets("元帳").Cells(1, 2) = kamokulist.Text

    Call 元帳

    Unload Me

End Sub

Private Sub cmdCancel_Click()

    Unload Me

End Sub

Sub 元帳()

    Dim kamokumei As String

    Dim lastrow As Long

    Dim i As Long

    Dim j As Long

    Dim kisyu As Long

    Dim kkubun As String

    Dim maezandaka As Long

    Dim zandaka As Long

    Dim kari As Long

    Dim kasi As Long

    Dim k As Long

    kamokumei = Worksheets("元帳").Cells(1, 2)

'元帳空白処理

'元帳伝票日付の最後が最終伝票と判断

    lastrow = Worksheets("元帳").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 3 To lastrow

        For j = 1 To 6

            Worksheets("元帳").Cells(i, j) = ""

        Next

    Next

'作業空白処理

    Worksheets("作業").Cells.Clear

    Worksheets("作業").Cells(1, 1) = "日付"

    Worksheets("作業").Cells(1, 2) = "相手科目"

    Worksheets("作業").Cells(1, 3) = "借方金額"

    Worksheets("作業").Cells(1, 4) = "貸方金額"

    Worksheets("作業").Cells(1, 5) = "残高"

    Worksheets("作業").Cells(1, 6) = "摘要"

    For i = 2 To lastrow

        For j = 1 To 6

            Worksheets("作業").Cells(i, j) = ""

        Next

    Next

'期首の取り出し

    kisyu = kisyukensaku(kamokumei)

    kkubun = kamokukubun(kamokumei)

'期首の追加

'日付と摘要

        Worksheets("作業").Cells(2, 1) = Worksheets("メニュー").Cells(2, 2)

'相手科目名

        Worksheets("作業").Cells(2, 2) = "期首残高"

'残高

        Worksheets("作業").Cells(2, 5) = kisyu

 

'科目区分の取り出し

'仕訳帳の取り出し

'仕訳帳日付の最後が最終伝票と判断して最後の行を取り出す

    lastrow = Worksheets("仕訳帳").Cells(Rows.Count, 1).End(xlUp).Row

    j = 3

    For i = 2 To lastrow

'借方の取り出し

        If Worksheets("仕訳帳").Cells(i, 3) = kamokumei Then

'日付と摘要

           Worksheets("作業").Cells(j, 1) = Worksheets("仕訳帳").Cells(i, 1)

           Worksheets("作業").Cells(j, 6) = Worksheets("仕訳帳").Cells(i, 8)

'相手科目名

           Worksheets("作業").Cells(j, 2) = Worksheets("仕訳帳").Cells(i, 6)

'借方金額

           Worksheets("作業").Cells(j, 3) = Worksheets("仕訳帳").Cells(i, 4)

           j = j + 1

        End If

'貸方の取り出し

        If Worksheets("仕訳帳").Cells(i, 6) = kamokumei Then

'日付と摘要

           Worksheets("作業").Cells(j, 1) = Worksheets("仕訳帳").Cells(i, 1)

           Worksheets("作業").Cells(j, 6) = Worksheets("仕訳帳").Cells(i, 8)

'相手科目名

           Worksheets("作業").Cells(j, 2) = Worksheets("仕訳帳").Cells(i, 3)

'貸方金額

           Worksheets("作業").Cells(j, 4) = Worksheets("仕訳帳").Cells(i, 7)

           j = j + 1

        End If

    Next

'作業データの日付順並び替え

    lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row

    Worksheets("作業").Activate

    Range(Cells(2, 1), Cells(lastrow, 6)).Select

    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 1), SortOn _

        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("作業").Sort

        .SetRange Range(Cells(2, 1), Cells(lastrow, 6))

        .Header = xlNo

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

'残高の計算

    maezandaka = kisyu

    For i = 3 To lastrow

        If kkubun = "流動資産" Or kkubun = "固定資産" Or kkubun = "仕入" Or kkubun = "販売管理費" Or kkubun = "営業外費用" Then

           zandaka = maezandaka + Worksheets("作業").Cells(i, 3) - Worksheets("作業").Cells(i, 4)

        Else

           zandaka = maezandaka + Worksheets("作業").Cells(i, 4) - Worksheets("作業").Cells(i, 3)

        End If

        Worksheets("作業").Cells(i, 5) = zandaka

        maezandaka = zandaka

    Next

'借方・貸方合計を計算

    For i = 3 To lastrow

        kari = kari + Worksheets("作業").Cells(i, 3)

        kasi = kasi + Worksheets("作業").Cells(i, 4)

    Next

'合計行追加

    Worksheets("作業").Cells(lastrow + 1, 1) = Worksheets("作業").Cells(lastrow, 1)

    Worksheets("作業").Cells(lastrow + 1, 2) = "合　　計"

    Worksheets("作業").Cells(lastrow + 1, 3) = kari

    Worksheets("作業").Cells(lastrow + 1, 4) = kasi

 

'加工した作業データを元帳へ転記

    j = 3

    For i = 2 To lastrow + 1

        For k = 1 To 6

            Worksheets("元帳").Cells(j, k) = Worksheets("作業").Cells(i, k)

        Next

        j = j + 1

    Next

    Sheets("元帳").Select

    Range("A1").Select

End Sub

期首金額を呼び出すkisyukensaku()関数

Function kisyukensaku(kname As String) As Long

         Dim lastrow As Long

         Dim i As Long

         lastrow = Worksheets("科目表").Cells(Rows.Count, 1).End(xlUp).Row

         For i = 2 To lastrow

             If kname = Worksheets("科目表").Cells(i, 2) Then

                kisyukensaku = Worksheets("科目表").Cells(i, 4)

                Exit Function

             End If

         Next

         kisyukensaku = 0

End Function

 

科目区分を呼び出すkamokukubun ()関数

Function kamokukubun(kname As String) As String

         Dim lastrow As Long

         Dim i As Long

         lastrow = Worksheets("科目表").Cells(Rows.Count, 1).End(xlUp).Row

         For i = 2 To lastrow

             If kname = Worksheets("科目表").Cells(i, 2) Then

                kamokukubun = Worksheets("科目表").Cells(i, 5)

                Exit Function

             End If

         Next

         kamokukubun = ""

End Function

Sub 元帳()

    mototyou.Show

End Sub