#8 物量表から重量単価[初期値]を推計
宮崎 稔也司令塔となるブックを別途用意する
今回から、プログラムの操作や管理をメインとするLibreOffice Calcのブックを作成し、そこにマクロのプログラムに作成していこうと思います。
そのような”司令塔”となるブックを別途1つ用意する方式のほうが、複数ある転記元と転記先のブックをよりわかりやすく操作・管理できるでしょう。
立山秀利著『脱入門者のExcel VBA』（ブルーバックス、ISBN978-4-06-257962-9）より引用。
このブックの名前は「重量単価初期値データ整理.ods」で、そのブックにあるワークシートは「作業用」という名前のもの1つのみとします。マクロのプログラムをこのブック内に作成していきます。
では、マクロの新規作成をしていきます。
詳細は、以下の投稿を参考になるかと。
https://note.com/toshiyamiyazaki/n/nd7c81f335821
プログラムを書く準備を終えたら、以下のようになりました。
今回は、産業連関物量表（以下、「物量表」）のデータを整理していきます。
物量表は、ブック「butsuryou.xlsx」のワークシート「物量表」になります。こちらのワークシートをコピーし、名前を「物量表_org」（orgはoriginの略）としておいておきます。
そして、実際のデータ整理はワークシート「物量表」の方を使っていきます。
基本分類物量表の作成
ワークシート「物量表」は、以下のようにデータが記載されています。
行部門ごとに、列コード999900（TOTAL）がある行に数量と金額のそれぞれの合計値が記載されています。また、数量単位の記載がないのに注意ですね。
この行部門ごとに、列コード999900（TOTAL）がある行を、ワークシート「基本分類物量表」に転記していくプログラムを作成しました。
Sub テスト用()
Dim wsOrg As Worksheet ' 転記元ワークシート
Dim wsDes As Worksheet ' 転記先ワークシート
Dim i As Long ' カウンター変数
Dim rw As Long ' 行番号カウンター変数
set wsOrg = Workbooks("butsuryo.xlsx").Worksheets("物量表")
set wsDes = Workbooks("butsuryo.xlsx").Worksheets("基本分類物量表")
rw = 2
For i = 3 To Rows.Count
If wsOrg.Cells(i, 3).Value = "999900" Then ' TOTALにさし当たったときの処理
wsDes.Cells(rw, 1).Value = wsOrg.Cells(i, 1).Value
wsDes.Cells(rw, 2).Value = wsOrg.Cells(i, 2).Value
wsDes.Cells(rw, 3).Value = wsOrg.Cells(i-1, 6).Value
wsDes.Cells(rw, 4).Value = wsOrg.Cells(i, 7).Value
wsDes.Cells(rw, 5).Value = wsOrg.Cells(i, 8).Value
rw = rw + 1
End If
Next
End Sub実行結果は以下のようになります。
結合小分類（185部門）でデータを整理
次に、ワークシート「基本分類物量表」に記載のある行コード7桁のうち、左から4桁が結合小分類の分類コードに該当するので、分類コードの一覧を作成します。
分類コード一覧は、ワークシート「bunruiCode」とします。
VBAプログラムは以下のようになります。
Sub テスト用()
Dim bunruiCode As String
Dim gyoCode As String
Dim tmp As String
Dim i As Long
Dim rw As Long
tmp = ""
rw = 2
For i = 2 To 115
gyoCode = Workbooks("butsuryo.xlsx").Worksheets("基本分類物量表").Cells(i, 1).Value
bunruiCode = Left(gyoCode, 4)
If bunruiCode <> tmp Then
Workbooks("butsuryo.xlsx").Worksheets("bunruiCode").Cells(rw, 1).Value = bunruiCode
rw = rw + 1
tmp = bunruiCode
End If
Next
End Sub実行結果は以下のようになります。
結合小分類ごとにワークシートを新規作成します。
プログラムは以下のようになります。
Sub 本番用()
Dim bunruiCode As String
Dim wSheet As Worksheet
Dim cnt As Integer
For cnt = 2 To 44
bunruiCode = Workbooks("butsuryo.xlsx").Worksheets("bunruiCode").Cells(cnt, 1).Value
' 最後尾にシートを追加
Set wSheet = Workbooks("butsuryo.xlsx").Worksheets.Add(After:=Workbooks("butsuryo.xlsx").Worksheets(Worksheets.Count))
' シート名を変更
wSheet.Name = bunruiCode
' 列名を入力
wSheet.RANGE("A1").VALUE = "コード"
wSheet.RANGE("B1").VALUE = "名称"
wSheet.RANGE("C1").VALUE = "単位"
wSheet.RANGE("D1").VALUE = "生産数量"
wSheet.RANGE("E1").VALUE = "単価（円）"
wSheet.RANGE("F1").VALUE = "生産額（百万円）"
Next
End Subそれでは、基本分類物量表のデータを、結合小分類毎のワークシートに転記するプログラムを書いていきます。
Sub 本番用()
Dim bunruiCode As String
Dim wb As Workbook
Dim wsOrg As Worksheet
Dim i As Long
Dim j As Long
Dim rw As Long
Set wb = Workbooks("butsuryo.xlsx")
Set wsOrg = wb.Worksheets("基本分類物量表")
For i = 2 To 44
bunruiCode = wb.Worksheets("bunruiCode").Cells(i, 1)
rw = 2
For j = 2 To 115
If wsOrg.Cells(j, 1).Value Like bunruiCode & "*" Then
wb.Worksheets(bunruiCode).Cells(rw, 1).Value = wsOrg.Cells(j, 1).Value
wb.Worksheets(bunruiCode).Cells(rw, 2).Value = wsOrg.Cells(j, 2).Value
wb.Worksheets(bunruiCode).Cells(rw, 3).Value = wsOrg.Cells(j, 3).Value
wb.Worksheets(bunruiCode).Cells(rw, 4).Value = wsOrg.Cells(j, 4).Value
wb.Worksheets(bunruiCode).Cells(rw, 6).Value = wsOrg.Cells(j, 5).Value
rw = rw + 1
End If
Next
Next
End Sub実行結果を見ると…
問題なく転記されました。
その後、（途中経過は省略します）結合小分類毎のワークシートを以下のように整え、重量単価[初期値]を算出する用意ができました。
物量表に重量が記載されている品目の重量単価[初期値]の推計
物量表のデータを整理できたので、重量単価[初期値]を推計していきます。
まず、結合小分類のワークシートすべてに対して、産業内製品の生産単位が[t]の製品の重量と生産額を積み上げて、重量単価[初期値]を推計します。
つまり、先日投稿した、下記の1),2)の方法に則って推計を行っていきます。
1）産業内製品の生産単位が全て[t]または[g],[kg]の場合、[g],[kg]は[t]に変換して算出します。算出式は以下のようになります。
Ux = Mx / Tx (2.1)
Ux : x産業の重量単価[円/t]
Mx : x産業の総生産額[円]
Tx : x産業の総生産量[t]
2）産業内製品の生産単位の一部が[t]または[g],[kg]の場合、その一部のみを用いて1）と同じように推計しました。
https://note.com/toshiyamiyazaki/n/n2c9ec33897e7
プログラムは以下のようになりました。
Sub 本番用()
Dim bunruiCode As String
Dim totalWeight As Double
Dim totalPrice As Double
Dim weightUnitPrice As Double
Dim wb As Workbook
Dim wsOrg As Worksheet
Dim i As Long
Dim j As Long
Set wb = Workbooks("butsuryo.xlsx")
Set wsOrg = wb.Worksheets("bunruiCode")
For i = 2 To 44
bunruiCode = wsOrg.Cells(i, 1).Value
weightUnitPrice = 0
totalWeight = 0
totalPrice = 0
For j = 2 To 300
If wb.Worksheets(bunruiCode).Cells(j, 3).Value = "t" Then
totalWeight = totalWeight + wb.Worksheets(bunruiCode).Cells(j, 4).Value
totalPrice = totalPrice + wb.Worksheets(bunruiCode).Cells(j, 6).Value
ElseIf wb.Worksheets(bunruiCode).Cells(j, 3).Value = "kg" Then
totalWeight = totalWeight + wb.Worksheets(bunruiCode).Cells(j, 4).Value / 1000
totalPrice = totalPrice + wb.Worksheets(bunruiCode).Cells(j, 6).Value
ElseIf wb.Worksheets(bunruiCode).Cells(j, 3).Value = "g" Then
totalWeight = totalWeight + wb.Worksheets(bunruiCode).Cells(j, 4).Value / 1000000
totalPrice = totalPrice + wb.Worksheets(bunruiCode).Cells(j, 6).Value
End If
Next
If totalWeight = 0 Then
GoTo Continue
End If
weightUnitPrice = totalPrice * 1000000 / totalWeight
wb.Worksheets(bunruiCode).Range("J2").NumberFormatLocal = "#,##0"
wb.Worksheets(bunruiCode).Range("J2").Value = weightUnitPrice
Continue:
Next i推計された各結合小分類の重量単価[初期値]を一つ一つ確認し、
・問題がなければシートは、タブの色を緑色に、
・検討が必要なシートは、タブの色を黄色に
・重量単価[初期値]が空欄（生産単位が重量表示の製品が1つもない）シートは、タブの色を赤色に
それぞれ変更します。
単位換算を用いて重量単価[初期値]を推計
分類コード0152（部門名：素材）
分類コード0152（部門名：素材）について、以前投稿した単位変換の表に換算値がありました。
なので、「素材」については単位換算値（0.5[t/m3])を用いて、重量単価[初期値]を推計します。
分類コード1121（部門名：酒類）
酒類については、物量表では生産単位がklで記載されているので、ここでは、単位換算値を（先述の表にはありませんでしたが）1.0[t/kl]と仮定して重量単価[初期値]を推計しました。
これまでに算出した重量単価初期値を一覧にしてみた
部門別品目別国内生産額表（以下、「生産額表」と表記）と物量表それぞれから求めた、結合小分類（185部門）の重量単価初期値一覧は、以下のようになりました。
C列が国内生産額表より算出した重量単価[初期値]、D列が物量表より算出した重量単価[初期値]になります。
一部の部門では、C列・D列ともに値がありますが、それらは国内生産額表より算出した値を採用しようと考えています。
また、D列で検討が必要と判断した部門（黄色のセル）は、全てC列に値が算出されているので、検討が不要なのかなと考えます。
Follow me!
