![見出し画像](https://assets.st-note.com/production/uploads/images/51652638/rectangle_large_type_2_3ecc7b6edca0be82d9d79ce65cf9dcc8.jpeg?width=1200)
#7 重量単価[初期値]設定(3)―単位換算値を用いて再計算―
先日は、各産業の重量単価[初期値]を自動推計するプログラムを作成しました。
推計した重量単価[初期値]の結果を一つずつ目視で確認していきます。
問題なく重量単価[初期値]を推計できたワークシートは、タブを緑色に変更します。
また、
・検討が必要なワークシートはタブを黄色に
・重量単価[初期値]が空欄の(生産単位に一つも[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 = "千N立方米" 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
再計算が済んだので、ワークシートのタブの色を緑色に変更します。
サポート、本当にありがとうございます。サポートしていただいた金額は、知的サイドハッスルとして取り組んでいる、個人研究の費用に充てさせていただきますね♪