見出し画像

#49 部門別品目別国内生産額表よりH17年岩手県重量単価初期値を推計

2021年11月6日から、H17年度岩手県の物質フローの推計に取り掛かりました。
まずは、H17年岩手県重量単価初期値の設定からです。

結合小分類一覧表の作成

手始めに、H17年岩手県産業連関表の結合小分類一覧を作成します。
岩手県産業連関表部門分類表を加工します。

加工前の岩手県産業連関表部門分類表は以下のようになります。

画像1

青枠で囲った空白行を削除し、詰めていって結合小分類の表を作成します。
こちらは、#4でやった作業です。

なので、その時のVBAのコードを少し修正するだけで、簡単にできました。

画像2

重量単価初期値を推計するワークシートの作成

次に、重量単価初期値を推計するためのワークシートを作成していきます。
目標物は以下のような条件を満たすものになります。

・結合小分類表の分類コードを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("列部門・8桁・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

上記のコードを実行して作成されたワークシートの一例が、以下のようになります。

画像3

上記の画像を見てわかるように、分類コード:0111(部門名:麦)に、分類コードが0110である米が含まれています。

これは、H17年岩手県産業連関表の部門分類が、H17年全国版産業連関表のそれと異なっているためです。

具体的にいうと、岩手県産業連関表では、米は分類コードが0110、麦が0111と別れている一方、全国版産業連関表だと、米と麦はともに、分類コードが0111となっているためです。

よって、上記の例であれば、米に属する品目(玄米、くず米、稲わら)はワークシート「0110」に転記する必要があります。

同じように、各生産品目が、岩手県産業連関表の部門分類に一致するように、適宜転記や削除をしていきます。この作業は手作業になりますね^^;

重量単価の初期値設定(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)と同じように推計しました。

(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]が含まれておらず、生産単位が体積である場合、製品の比重を設定することで推計します。各部門とその製品の比重を、自身の修士論文から引用します。

画像4

分類コード:0611(部門名:石炭・原油・天然ガス)

現状では、ワークシートは以下のようになっています。

画像5

重量単価[初期値]は、(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]である飲用牛乳があります。

画像7

これらは、先述の単位変換の「飲用牛乳」の値を使って、[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(部門名:その他の飲料)

生産額表は以下のようになっています。

画像6

先述の単位変換の「清涼飲料」の単位換算値(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 "A重油" Then
			totalPrice = totalPrice + wSheet.Cells(i, 6).Value
			totalWeight = totalWeight + wSheet.Cells(i, 4).Value * 0.865
		ElseIf wSheet.Cells(i, 2).Value Like "B重油・C重油" 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





サポート、本当にありがとうございます。サポートしていただいた金額は、知的サイドハッスルとして取り組んでいる、個人研究の費用に充てさせていただきますね♪