#7 重量単価[初期値]設定（3）―単位換算値を用いて再計算―

在野研究者トシヤ

2021年5月6日 12:49

先日は、各産業の重量単価[初期値]を自動推計するプログラムを作成しました。

推計した重量単価[初期値]の結果を一つずつ目視で確認していきます。
問題なく重量単価[初期値]を推計できたワークシートは、タブを緑色に変更します。

また、

・検討が必要なワークシートはタブを黄色に
・重量単価[初期値]が空欄の（生産単位に一つも[t],[g],[kg]が含まれていない）ワークシートはタブを赤色に

それぞれ変更していきます。

タブが黄色のワークシートの検討・再計算

次に、タブが黄色になったワークシートを一つずつ検討していきます。

分類コード：0621（部門名：砂利・砕石）

生産単位が[千t]という生産品目があったので、それらを推計の対象として、再計算します。

Sub テスト用()
	With Worksheets("0621")
		Dim weightUnitPrice As Double
		Dim totalWeight As Double
		Dim totalPrice As Double
		For cnt=2 To 12
			If Range("C" & cnt).Value = "t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			ElseIf 	Range("C" & cnt).Value = "千t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 1000
			End If
		Next
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Range("J2").Value = weightUnitPrice
	End With
End Sub

ワークシートが1つしか登場しないので、With文でまとめてみました。

再計算が済んだので、ワークシートのタブの色を緑色に変更します。

分類コード：0629（部門名：その他の鉱物）

生産単位が[含有量g]という生産品目があったので、それを推計対象として、再計算します。

Sub テスト用()
	With Worksheets("0629")
		Dim weightUnitPrice As Double
		Dim totalWeight As Double
		Dim totalPrice As Double
		For cnt=2 To 300
			If Range("C" & cnt).Value = "t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			ElseIf 	Range("C" & cnt).Value = "含有量g" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value / 1000000
			End If
		Next
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Range("J2").Value = weightUnitPrice
	End With
End Sub

再計算が済んだので、ワークシートのタブの色を緑色に変更します。

分類コード：2721（部門名：電線・ケーブル）

生産単位が[導体t]という生産品目があったので、それらを推計対象として再計算します。

Sub テスト用()
	With Worksheets("2721")
		Dim weightUnitPrice As Double
		Dim totalWeight As Double
		Dim totalPrice As Double
		For cnt=2 To 300
			If Range("C" & cnt).Value = "t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			ElseIf 	Range("C" & cnt).Value = "導体t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			End If
		Next
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Range("J2").Value = weightUnitPrice
	End With
End Sub

再計算が済んだので、ワークシートのタブの色を緑色に変更します。

重量単価[初期値]設定（3）

（3）産業内生産品の生産単位に一つも[t], [g],[kg]が含まれておらず、生産単位が体積である場合、製品の比重を設定することで推計します。各部門とその製品の比重を修士論文から引用します。

分類コード：0611（部門名：石炭・原油・天然ガス）

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

重量単価[初期値]は、（1）の方法で算出してあるのですが、算出式には生産単位が[t]の「石炭及び亜炭（精炭）」のみが計上されています。

一方、産単位が[kl]の「原油」と、[千N立法米]の「ガス田ガス・炭田ガス（構造性）」、「ガス田ガス・炭田ガス（水溶性）」が算出式に計上されていません。

なので、先述の単位変換を用いて、原油と天然ガスを含んだ重量単価[初期値]を算出します。

Sub テスト用()
	With Worksheets("0611")
		Dim weightUnitPrice As Double
		Dim totalWeight As Double
		Dim totalPrice As Double
		For cnt=2 To 300
			If Range("C" & cnt).Value = "t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			ElseIf 	Range("C" & cnt).Value = "kl" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 0.865
			ElseIf 	Range("C" & cnt).Value = "千Ｎ立方米" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 0.714
			End If
		Next
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Range("J2").Value = weightUnitPrice
	End With
End Sub

再計算が済んだので、ワークシートのタブの色を緑色に変更します。

分類コード：1111（部門名：畜産食料品）

生産額表の一部に、単位が[kl]である乳製品があります。

これらは、先述の単位変換の「飲用牛乳」の値を使って、[t]に変換して、重量単価[初期値]を再計算します。

Sub テスト用()
	With Worksheets("1111")
		Dim weightUnitPrice As Double
		Dim totalWeight As Double
		Dim totalPrice As Double
		For cnt=2 To 300
			If Range("C" & cnt).Value = "t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			End If
			For i=28 To 32
				totalPrice = totalPrice + Range("F" & i).Value
				totalWeight = totalWeight + Range("D" & i).Value * 0.1034
			Next
		Next
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Range("J2").Value = weightUnitPrice
	End With
End Sub

再計算が済んだので、ワークシートのタブの色を緑色に変更します。

分類コード：1129（部門名：その他の飲料）

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

先述の単位変換の「清涼飲料」の単位換算値（1.0t/kl）を用いて、飲料の生産単位を[kl]から[t]に換算して、重量単価[初期値]を再計算します。

Sub テスト用()
	With Worksheets("1129")
		Dim weightUnitPrice As Double
		Dim totalWeight As Double
		Dim totalPrice As Double
		For cnt=2 To 300
			If Range("C" & cnt).Value = "t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			ElseIf Range("C" & cnt).Value = "kl" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 1.0
			End If
		Next
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Range("J2").Value = weightUnitPrice
	End With
End Sub

再計算が済んだので、ワークシートのタブの色を緑色に変更します。

分類コード：2111（部門名：石油製品）

上述の単位変換の表での「石油製品」の単位換算値（0.865[t/kl]）を用いて、「ガソリン」・「ジェット燃料油」・「灯油」・「軽油」・「A重油」・「B・C重油」の生産単位を[t]に換算して、重量単価[初期値]を再計算します。

Sub テスト用()
	With Worksheets("2111")
		Dim weightUnitPrice As Double
		Dim totalWeight As Double
		Dim totalPrice As Double
		For cnt=2 To 300
			If Range("C" & cnt).Value = "t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			ElseIf Range("B" & cnt).Value Like "*ガソリン*" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 0.865
			ElseIf Range("B" & cnt).Value Like "*ジェット*" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 0.865
			ElseIf Range("B" & cnt).Value Like "*灯油*" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 0.865
			ElseIf Range("B" & cnt).Value Like "*軽油*" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 0.865
			ElseIf Range("B" & cnt).Value Like "*重油*" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 0.865
			End If
		Next
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Range("J2").Value = weightUnitPrice
	End With
End Sub

再計算が済んだので、ワークシートのタブの色を緑色に変更します。

分類コード：2521（部門名：セメント・セメント製品）

上述の単位変換の表の、「生コンクリート」の単位換算値を用いて、重量単価[初期値]を再計算します。

Sub テスト用()
	With Worksheets("2521")
		Dim weightUnitPrice As Double
		Dim totalWeight As Double
		Dim totalPrice As Double
		For cnt=2 To 300
			If Range("C" & cnt).Value = "t" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value
			ElseIf Range("B" & cnt).Value = "生コンクリート" Then
				totalPrice = totalPrice + Range("F" & cnt).Value
				totalWeight = totalWeight + Range("D" & cnt).Value * 1.5
			End If
		Next
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Range("J2").Value = weightUnitPrice
	End With
End Sub

再計算が済んだので、ワークシートのタブの色を緑色に変更します。

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