Photo by
yuuuko2020
#49 部門別品目別国内生産額表よりH17年岩手県重量単価初期値を推計
2021年11月6日から、H17年度岩手県の物質フローの推計に取り掛かりました。
まずは、H17年岩手県重量単価初期値の設定からです。
結合小分類一覧表の作成
手始めに、H17年岩手県産業連関表の結合小分類一覧を作成します。
岩手県産業連関表部門分類表を加工します。
加工前の岩手県産業連関表部門分類表は以下のようになります。
青枠で囲った空白行を削除し、詰めていって結合小分類の表を作成します。
こちらは、#4でやった作業です。
なので、その時のVBAのコードを少し修正するだけで、簡単にできました。
重量単価初期値を推計するワークシートの作成
次に、重量単価初期値を推計するためのワークシートを作成していきます。
目標物は以下のような条件を満たすものになります。
・結合小分類表の分類コードを1つずつ読み込んで、分類コード毎に新規ワークシートを作成する。
・新規ワークシート名は、部門コード（4桁）に変更する
・ワークブック「部門別品目別国内生産額表」中の各細品目のデータ（コード、名称、単位、生産数量、単価（円）、生産額（百万円））を部門コードにしたがって、属するワークシートに転記する。
以下が、目標物を作成するためのVBAのコードになります。
Option VBASupport 1
REM ***** BASIC *****
Sub 分類コード毎に新規ワークシート作成()
' 分類コードを読み込んで、分類コード1個毎に新規ワークシートを作成する
Dim bunruiCode As String
Dim bumonmei As String
Dim wbOrg1 As Worksheet
Dim wbOrg2 As Worksheet
Dim wbDes AS Workbook
Dim wSheet As Worksheet
Set wbOrg1 = Workbooks("平成17年岩手県産業連関表結合小分類一覧.ods").Worksheets("部門分類表")
Set wbOrg2 = Workbooks("H17部門別品目別国内生産額表.ods").Worksheets("列部門・８桁・10桁分類別CT")
Set wbDes = Workbooks("H17岩手県重量単価初期値推計.ods")
For i = 2 To 132
bunruiCode = wbOrg1.Cells(i, 1).Value
bumonmei = wbOrg1.Cells(i, 2).Value
' 最後尾にシートを追加
Set wSheet = wbDes.Worksheets.Add(before:=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 = "生産額（百万円）"
wSheet.RANGE("H1").Value = "分類コード"
wSheet.Range("H2").NumberFormatLocal = "@"
wSheet.RANGE("H2").Value = bunruiCode
wSheet.RANGE("I1").Value = "部門名"
wSheet.RANGE("I2").Value = bumonmei
wSheet.RANGE("J1").Value = "重量単価[初期値]"
' データを入力
rw = 2
For cnt = 3 To 4000
If wbOrg2.Cells(cnt, 5).Value Like bunruiCode & "*" Then
wSheet.Cells(rw, 1).NumberFormatLocal = "@"
wSheet.Cells(rw, 1).Value = wbOrg2.Cells(cnt, 5).Value
wSheet.Cells(rw, 2).Value = wbOrg2.Cells(cnt, 6).Value
wSheet.Cells(rw, 3).Value = wbOrg2.Cells(cnt, 7).Value
wSheet.Cells(rw, 4).Value = wbOrg2.Cells(cnt, 8).Value
wSheet.Cells(rw, 5).Value = wbOrg2.Cells(cnt, 9).Value
wSheet.Cells(rw, 6).Value = wbOrg2.Cells(cnt, 10).Value
rw = rw + 1
End If
Next
Next
End Sub上記のコードを実行して作成されたワークシートの一例が、以下のようになります。
上記の画像を見てわかるように、分類コード：0111（部門名：麦）に、分類コードが0110である米が含まれています。
これは、H17年岩手県産業連関表の部門分類が、H17年全国版産業連関表のそれと異なっているためです。
具体的にいうと、岩手県産業連関表では、米は分類コードが0110、麦が0111と別れている一方、全国版産業連関表だと、米と麦はともに、分類コードが0111となっているためです。
よって、上記の例であれば、米に属する品目（玄米、くず米、稲わら）はワークシート「0110」に転記する必要があります。
同じように、各生産品目が、岩手県産業連関表の部門分類に一致するように、適宜転記や削除をしていきます。この作業は手作業になりますね^^;
重量単価の初期値設定（１）と（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）と同じように推計しました。
（1）と（2）の具体例は、#6で言及しています。
それでは、（1）と（2）をVBAで実装していきます。
Sub 重量単価初期値推計()
' 重量単価【初期値】を自動計算する
Dim bunruiCode As String
Dim totalWeight As Double
Dim totalPrice As Double
Dim pricePerTon As Double
Dim wbOrg As Worksheet
Dim wbDes As Workbook
Set wbOrg = Workbooks("平成17年岩手県産業連関表結合小分類一覧.ods").Worksheets("部門分類表")
Set wbDes = Workbooks("H17岩手県重量単価初期値推計.ods")
For cnt = 2 To 131
bunruiCode = wbOrg.Cells(cnt, 1).Value
pricePerTon = 0
totalWeight = 0
totalPrice = 0
For i = 2 To 1000
If wbDes.Worksheets(bunruiCode).Cells(i, 3).Value = "千t" Then
totalWeight = totalWeight + wbDes.Worksheets(bunruiCode).Cells(i, 4).Value * 1000
totalPrice = totalPrice + wbDes.Worksheets(bunruiCode).Cells(i, 6).Value
ElseIf wbDes.Worksheets(bunruiCode).Cells(i, 3).Value = "t" Then
totalWeight = totalWeight + wbDes.Worksheets(bunruiCode).Cells(i, 4).Value
totalPrice = totalPrice + wbDes.Worksheets(bunruiCode).Cells(i, 6).Value
ElseIf wbDes.Worksheets(bunruiCode).Cells(i, 3).Value = "導体t" Then
totalWeight = totalWeight + wbDes.Worksheets(bunruiCode).Cells(i, 4).Value
totalPrice = totalPrice + wbDes.Worksheets(bunruiCode).Cells(i, 6).Value
ElseIf wbDes.Worksheets(bunruiCode).Cells(i, 3).Value = "kg" Then
totalWeight = totalWeight + wbDes.Worksheets(bunruiCode).Cells(i, 4).Value / 1000
totalPrice = totalPrice + wbDes.Worksheets(bunruiCode).Cells(i, 6).Value
ElseIf wbDes.Worksheets(bunruiCode).Cells(i, 3).Value = "g" Then
totalWeight = totalWeight + wbDes.Worksheets(bunruiCode).Cells(i, 4).Value / 1000000
totalPrice = totalPrice + wbDes.Worksheets(bunruiCode).Cells(i, 6).Value
End If
Next
If totalWeight = 0 Then
GoTo Continue
End If
pricePerTon = totalPrice * 1000000 / totalWeight
wbDes.Worksheets(bunruiCode).Cells(2, 10).Value = pricePerTon
Continue:
Next cnt
End Sub重量単価[初期値]設定（3）
（3）産業内生産品の生産単位に一つも[t], [g],[kg]が含まれておらず、生産単位が体積である場合、製品の比重を設定することで推計します。各部門とその製品の比重を、自身の修士論文から引用します。
分類コード：0611（部門名：石炭・原油・天然ガス）
現状では、ワークシートは以下のようになっています。
重量単価[初期値]は、（1）の方法で算出してあるのですが、算出式には生産単位が[t]の「石炭」のみが計上されています。
一方、産単位が[kl]の「原油」と、[千立法米]の「天然ガス」が算出式に計上されていません。
なので、先述の単位変換を用いて、原油と天然ガスを含んだ重量単価[初期値]を算出します。
Sub 単位換算での重量単価初期値推計()
' 単位換算での重量単価初期値の推計
Dim totalWeight As Double
Dim totalPrice As Double
Dim pricePerTon As Double
Dim wSheet As Worksheet
Set wSheet = Workbooks("H17岩手県重量単価初期値推計.ods").Worksheets("0711")
pricePerTon = 0
totalWeight = 0
totalPrice = 0
For i = 2 To 1000
If wSheet.Cells(i, 3).Value = "t" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
ElseIf wSheet.Cells(i, 3).Value = "kl" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
ElseIf wSheet.Cells(i, 3).Value = "千立方米" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.714
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
End If
Next
pricePerTon = totalPrice * 1000000 / totalWeight
wSheet.Cells(2, 10).Value = pricePerTon
End Sub再計算が済んだので、ワークシートのタブの色を青色に変更します。
分類コード：1112（部門名：畜産食料品）
生産額表の一部に、単位が[kl]である飲用牛乳があります。
これらは、先述の単位変換の「飲用牛乳」の値を使って、[t]に変換して、重量単価[初期値]を再計算します。
Sub 単位換算での重量単価初期値推計()
' 単位換算での重量単価初期値の推計
Dim totalWeight As Double
Dim totalPrice As Double
Dim pricePerTon As Double
Dim wSheet As Worksheet
Set wSheet = Workbooks("H17岩手県重量単価初期値推計.ods").Worksheets("1112")
pricePerTon = 0
totalWeight = 0
totalPrice = 0
For i = 2 To 1000
If wSheet.Cells(i, 3).Value = "t" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
ElseIf wSheet.Cells(i, 1).Value Like "11120310" & "*" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.1034
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
End If
Next
pricePerTon = totalPrice * 1000000 / totalWeight
wSheet.Cells(2, 10).Value = pricePerTon
End Sub分類コード：1129（部門名：その他の飲料）
生産額表は以下のようになっています。
先述の単位変換の「清涼飲料」の単位換算値（1.0t/kl）を用いて、清涼飲料の生産単位を[kl]から[t]に換算して、重量単価[初期値]を再計算します。
Sub 単位換算での重量単価初期値推計()
' 単位換算での重量単価初期値の推計
Dim totalWeight As Double
Dim totalPrice As Double
Dim pricePerTon As Double
Dim wSheet As Worksheet
Set wSheet = Workbooks("H17岩手県重量単価初期値推計.ods").Worksheets("1129")
pricePerTon = 0
totalWeight = 0
totalPrice = 0
For i = 2 To 1000
If wSheet.Cells(i, 3).Value = "t" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
ElseIf wSheet.Cells(i, 3).Value = "kl" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 1.0
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
End If
Next
pricePerTon = totalPrice * 1000000 / totalWeight
wSheet.Cells(2, 10).Value = pricePerTon
End Sub分類コード：2111（部門名：石油製品）
上述の単位変換の表での「石油製品」の単位換算値（0.865[t/kl]）を用いて、「ガソリン」・「ジェット燃料油」・「灯油」・「軽油」・「A重油」・「B・C重油」、「ナフサ」の生産単位を[t]に換算して、重量単価[初期値]を再計算します。
Sub 単位換算での重量単価初期値推計()
' 単位換算での重量単価初期値の推計
Dim totalWeight As Double
Dim totalPrice As Double
Dim pricePerTon As Double
Dim wSheet As Worksheet
Set wSheet = Workbooks("H17岩手県重量単価初期値推計.ods").Worksheets("2111")
pricePerTon = 0
totalWeight = 0
totalPrice = 0
For i = 2 To 1000
If wSheet.Cells(i, 3).Value = "t" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
ElseIf wSheet.Cells(i, 2).Value Like "自動車ガソリン" +"*" Then
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
ElseIf wSheet.Cells(i, 2).Value Like "*" + "ガソリン" Then
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
ElseIf wSheet.Cells(i, 2).Value Like "灯油" Then
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
ElseIf wSheet.Cells(i, 2).Value Like "軽油" Then
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
ElseIf wSheet.Cells(i, 2).Value Like "Ａ重油" Then
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
ElseIf wSheet.Cells(i, 2).Value Like "Ｂ重油・Ｃ重油" Then
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
ElseIf wSheet.Cells(i, 2).Value Like "石油化学用" Then
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
ElseIf wSheet.Cells(i, 2).Value Like "その他用" Then
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
End If
Next
pricePerTon = totalPrice * 1000000 / totalWeight
wSheet.Cells(2, 10).Value = pricePerTon
End Sub分類コード：2522（部門名：セメント・セメント製品）
上述の単位変換の表の、「生コンクリート」の単位換算値を用いて、重量単価[初期値]を再計算します。
Sub 単位換算での重量単価初期値推計()
' 単位換算での重量単価初期値の推計
Dim totalWeight As Double
Dim totalPrice As Double
Dim pricePerTon As Double
Dim wSheet As Worksheet
Set wSheet = Workbooks("H17岩手県重量単価初期値推計.ods").Worksheets("2522")
pricePerTon = 0
totalWeight = 0
totalPrice = 0
For i = 2 To 1000
If wSheet.Cells(i, 3).Value = "t" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
ElseIf wSheet.Cells(i, 2).Value = "生コンクリート" Then
totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 1.5
totalPrice = totalPrice + wSheet.Cells(i, 6).Value
End If
Next
pricePerTon = totalPrice * 1000000 / totalWeight
wSheet.Cells(2, 10).Value = pricePerTon
End Subいいなと思ったら応援しよう！
