#140　2013年（平成25年）大阪府産業連関表における投入額の推計

前回の投稿（投稿#139）にて、粗付加価値額の推計が完了しました。

今回の投稿は、中間投入額の推計についてです。

（１）中間投入係数の推計

推計方法の確認

下式（変化率方式）により投入係数を求め、平成25年大阪府延長表の生産額を乗じた。下式（変化率方式）により投入係数を求め、平成25年大阪府延長表の生産額を乗じた。

$$
平成23年大阪府基本表の投入係数×\frac{平成25年全国延長表の投入係数}{平成23年全国基本表の投入係数}\
$$

なお、中間投入額の推計方法については、RAS法、RECRAS法、変化率方式による推計と検証を行い、最も当てはまりが良かった変化率方式を採用した。なお、中間投入額の推計方法については、RAS法、RECRAS法、変化率方式による推計と検証を行い、最も当てはまりが良かった変化率方式を採用した。

大阪府総務部統計課「平成25年（2013年）大阪府産業連関表（延長表）報告書」より

平成25年全国延長表（基本分類）の部門統合

平成25年全国延長表（経済産業省）は統合小分類（190部門）での投入係数表が公表されていません。そこで、まずは平成25年全国延長表の統合小分類（190部門）での取引基本表を作成します。

平成25年全国延長表の基本分類での取引基本表を加工、つまり、基本分類を統合小分類に部門統合していきます。

最初にタテ（列方向）に部門統合した後、ヨコ（行方向）に部門統合していくことになります。

平成25年全国延長表のタテ（列方向）での部門統合

平成25年全国延長表をタテ（列方向）に部門統合を行うVBAのコードは、以下のようになります。

Sub 列方向部門統合()
    Dim WsOrg As Worksheet      '転記元ワークシート
    Dim WsDes As Worksheet      '転記先ワークシート
    Dim i As Integer            'カウンタ変数
    Dim OrgRow As Integer       'カウンタ変数
    Dim DesRow As Integer       'カウンタ変数
    Dim code4d As String        '4桁コード
    Dim sum As Long             '中間投入額の合計
    Const FirstColumn = 3       '開始列番号
    Const LastColumn = 397      '最終列番号
    Const OrgFirstRow = 3       '転記元開始行番号
    Const OrgLastRow = 518      '転記元終了行番号
    Const DesFirstRow = 3       '転記先開始行番号
    Const DesLastRow = 192      '転記先終了行番号
    Const CodeColumn = 1        'code列番号

    Set WsOrg = Workbooks("H25全国延長表統合.ods").Worksheets("基本分類")
    Set WsDes = Workbooks("H25全国延長表統合.ods").Worksheets("列方向統合")

    For i = FirstColumn To LastColumn
        OrgRow = 3
        DesRow = 3
        Do While DesRow <= DesLastRow
            code4d = WsDes.Cells(DesRow, CodeColumn).Value
            sum = 0
            Do While WsOrg.Cells(OrgRow, CodeColumn).Value Like code4d & "[0-9][0-9][0-9]"
                sum = sum + WsOrg.Cells(OrgRow, i).Value
                OrgRow = OrgRow + 1
            Loop
            WsDes.Cells(DesRow, i) = sum
            DesRow = DesRow + 1
        Loop
    Next
End Sub

平成25年全国延長表のヨコ（行方向）での部門統合

タテ（列方向）に続いて、平成25年全国延長表をヨコ（行方向）に部門統合を行うVBAのコードは、以下のようになります。

Sub 行方向部門統合()
    Dim WsOrg As Worksheet      '転記元ワークシート
    Dim WsDes As Worksheet      '転記先ワークシート
    Dim i As Integer            'カウンタ変数
    Dim OrgColumn As Integer    'カウンタ変数
    Dim DesColumn As Integer    'カウンタ変数
    Dim code4d As String        '4桁コード
    Dim sum As Long             '中間投入額の合計
    Const DesFirstRow = 3       '転記先開始行番号
    Const DesLastRow = 204      '転記先最終行番号
    Const DesLastColumn = 192   '転記先最終列番号
    Const CodeRow = 1           'code行番号

    Set WsOrg = Workbooks("H25全国延長表統合.ods").Worksheets("列方向統合")
    Set WsDes = Workbooks("H25全国延長表統合.ods").Worksheets("H25全国延長表生産額（190部門）")

    For i = DesFirstRow To DesLastRow
        OrgColumn = 3
        DesColumn = 3
        Do While DesColumn <= DesLastColumn
            code4d = WsDes.Cells(CodeRow, DesColumn).Value
            sum = 0
            Do While WsOrg.Cells(CodeRow, OrgColumn).Value Like code4d & "[0-9][0-9]"
                sum = sum + WsOrg.Cells(i, OrgColumn).Value
                OrgColumn = OrgColumn + 1
            Loop
            WsDes.Cells(i, DesColumn) = sum
            DesColumn = DesColumn + 1
        Loop
    Next    
End Sub

平成25年全国延長表の投入係数の推計（「自家輸送」部門は除く）

ここまでで、統合小分類（190部門）での平成25年全国延長表が作成できました。次は、中間投入係数を推計します。中間投入係数は、以下の算出式で推計します。

$$
各項目の中間投入係数 = \frac{各項目の中間投入額}{各項目の全国生産額}\
$$

中間投入係数を推計するVBAのコードは、以下のようになります。

Sub 投入係数推計()
    Dim WsOrg As Worksheet      '転記元ワークシート
    Dim WsDes As Worksheet      '転記先ワークシート
    Dim i As Integer            'カウンタ変数
    Dim j As Integer            'カウンタ変数
    Dim Pro As Long             '全国生産額
    Const FirstRow = 3          '作業開始行番号
    Const LastRow = 192         '作業終了行番号
    Const FirstColumn = 3       '作業開始列番号
    Const LastColumn = 192      '作業終了列番号
    Const ProRow = 204          '全国生産額行番号

    Set WsOrg = Workbooks("H25全国延長表統合.ods").Worksheets("H25全国延長表生産額（190部門）")
    Set WsDes = Workbooks("H25全国延長表統合.ods").Worksheets("H25全国延長表投入係数")

    For i = FirstColumn To LastColumn
        Pro = WsOrg.Cells(ProRow, i).Value
        If Pro = 0 Then
            WsDes.Cells(ProRow, i) = 0
            Goto Continue
        Else
            For j = FirstRow To LastRow
                WsDes.Cells(j, i) = WsOrg.Cells(j, i) / Pro
                WsDes.Cells(ProRow, i) = 1
            Next
        End If
    Continue:Next
End Sub

「自家輸送」部門の投入係数について

平成25年全国延長表では、「5731 自家輸送（旅客自動車）」及び「5732 自家輸送（貨物自動車）」の特掲は行われていません。よって、上述のVBAのコードでは、「自家輸送」部門の中間投入係数を推計することができません。

したがって、本研究では、「自家輸送」部門において、平成25年全国延長表の投入係数は平成23年全国基本表の投入係数と比較して変化しないという仮定を置くことにします。

その仮定に基づくと、平成25年大阪府延長表の投入係数を推計する下式
$$
平成23年大阪府基本表の投入係数 × \frac{平成25年全国延長表の投入係数}{平成23年全国基本表の投入係数}\
$$
において、第2項の分子と分母が等しくなることから、「自家輸送」部門の平成25年大阪府延長表の投入係数は、平成23年大阪府基本表の投入係数と等しくなります。

よって、本研究では、「自家輸送」部門における平成25年大阪府延長表の投入係数は、平成23年大阪府基本表の投入係数と等しいと仮定することになります。

平成25年大阪府延長表の投入係数の推計

中間投入係数を推計する式（変化率方式）を再掲します。

$$
平成23年大阪府基本表の投入係数×\frac{平成25年全国延長表の投入係数}{平成23年全国基本表の投入係数}\
$$

平成25年大阪府延長表の投入係数を推計するVBAのコードは、以下のようになります。

Sub 変化率方式()
    Dim WsOrg1 As Worksheet     '転記元ワークシート
    Dim WsOrg2 As Worksheet     '転記元ワークシート
    Dim WsOrg3 As Worksheet     '転記元ワークシート
    Dim WsDes As Worksheet      '転記先ワークシート
    Dim i As Integer            'カウンタ変数
    Dim j As Integer            'カウンタ変数
    Dim Pro As Long             '全国生産額
    Const FirstRow = 3          '作業開始行番号
    Const LastRow = 192         '作業終了行番号
    Const FirstColumn = 3       '作業開始列番号
    Const LastColumn = 192      '作業終了列番号
    Const ProRow = 204          '全国生産額行番号

    Set WsOrg1 = Workbooks("中間投入額推計シート_平成25年大阪府産業連関表.ods").Worksheets("H23大阪府基本表投入係数")
    Set WsOrg2 = Workbooks("中間投入額推計シート_平成25年大阪府産業連関表.ods").Worksheets("H25全国延長表投入係数")
    Set WsOrg3 = Workbooks("中間投入額推計シート_平成25年大阪府産業連関表.ods").Worksheets("H23全国基本表投入係数")
    Set WsDes = Workbooks("中間投入額推計シート_平成25年大阪府産業連関表.ods").Worksheets("H25大阪府延長表投入係数")

    For i = FirstColumn To LastColumn
        Pro = WsOrg3.Cells(ProRow, i).Value
        If Pro = 0 Then
            Goto Continue1
        Else
            For j = FirstRow To LastRow
                If WsOrg1.Cells(j, i).Value = 0 Then
                    WsDes.Cells(j, i).Value = 0
                    Goto Continue2
                Else
                    WsDes.Cells(j, i).Value = WsOrg1.Cells(j, i).Value * WsOrg2.Cells(j, i).Value / WsOrg3.Cells(j, i).Value
                End If
            Continue2:Next
        End If
    Continue1:Next
End Sub

中間投入額を推計

先程推計した投入係数に、平成25年大阪府延長表の生産額を乗じることで、中間投入額を推計します。

中間投入額を推計するVBAのコードは、以下のようになります。

Sub 中間投入額推計()
    Dim WsOrg As Worksheet      '転記元ワークシート
    Dim WsDes As Worksheet      '転記先ワークシート
    Dim i As Integer            'カウンタ変数
    Dim j As Integer            'カウンタ変数
    Dim pro As Long             '府内生産額
    Dim midratio As Double      '中間投入係数
    Const FirstRow = 3          '作業開始行番号
    Const LastRow = 192         '作業終了行番号
    Const FirstColumn = 3       '作業開始列番号
    Const LastColumn = 192      '作業終了列番号
    Const ProRow = 204          '府内生産額行番号

    Set WsOrg = Workbooks("中間投入額推計シート_平成25年大阪府産業連関表.ods").Worksheets("H25大阪府延長表投入係数")
    Set WsDes = Workbooks("中間投入額推計シート_平成25年大阪府産業連関表.ods").Worksheets("H25大阪府延長表中間投入額")

    For i = FirstColumn To LastColumn
        pro = WsDes.Cells(ProRow, i)
        For j = FirstRow To LastRow
            If pro = 0 Then
                WsDes.Cells(j, i) = 0
            Else
                midratio = WsOrg.Cells(j, i)
                WsDes.Cells(j, i) = int(pro * midratio)
            End If
        Next
    Continue:Next
End Sub

差額調整

列和が生産額と一致するよう、差額を中間投入額の列和に占める各内訳額の構成比により按分し、各内訳額に加えて調整した。

大阪府総務部統計課「平成25年（2013年）大阪府産業連関表（延長表）報告書」より

差額調整を行うVBAのコードは、以下のようになります。

Sub 中間投入額の差額調整()
    Dim WsOrg As Worksheet      '転記元ワークシート
    Dim WsDes As Worksheet      '転記先ワークシート
    Dim i As Integer            'カウンタ変数
    Dim j As Integer            'カウンタ変数
    Dim pro As Long             '府内生産額
    Dim tmp As Long             '差額調整前の中間投入の内訳額
    Dim diff As Long            '差額
    Dim sum As Long             '中間投入の内訳額の列和
    Dim ratio As Double         '粗付加価値部門の各項目の内訳額の行和に占める各内訳額の構成比
    Dim result As Double        '調整結果
    Const FirstColumn = 3       '調整開始列番号
    Const LastColumn = 192      '調整終了列番号
    Const FirstRow = 3          '調整開始行番号
    Const LastRow = 202         '調整終了行番号
    Const ProRow = 204          '府内生産額の行番号
    Const SumRow = 205          '中間投入の内訳額の列和行番号

    Set WsOrg = Workbooks("中間投入額推計シート_平成25年大阪府産業連関表.ods").Worksheets("H25大阪府延長表中間投入額")
    Set WsDes = Workbooks("中間投入額推計シート_平成25年大阪府産業連関表.ods").Worksheets("H25大阪府延長表中間投入額差額調整")

    For i = FirstColumn to LastColumn
        pro = WsOrg.Cells(ProRow, i) 
        sum = WsOrg.Cells(SumRow, i)
        diff = pro - sum
        For j = FirstRow to LastRow
            If pro = 0 Then
                WsDes.Cells(j, i) = 0
            Else
                tmp = WsOrg.Cells(j, i).Value
                ratio = tmp / sum
                result = tmp + diff * ratio
                WsDes.Cells(j, i) = result
            End If
        Next
    Next
End Sub