#6 重量単価の初期値設定(1)と(2)をVBAで実現

今日から、各産業の重量単価[初期値]の推定に取り掛かります。
その前に、前回作成した186部門の各シートに、

・部門コード
・部門名
・重量単価[初期値]

を入力する2行×3列の表を作成しておきます。

画像1

部門コードと部門名は、表「内生部門」からワークシート名と一致するものを順に読み込んで転記していきます。

セルの書式設定するNumberFormatLocal

作成したVBAプログラムは以下のようになります。

Sub 本番用()
	Dim bunruiCode As String
	For i = 10 To 195
			bunruiCode = Worksheets("内生部門").RANGE("G" & i).VALUE
		' 1行目に列名を代入
		Worksheets(bunruiCode).Range("H1").Value = "分類コード"
		Worksheets(bunruiCode).Range("I1").Value = "部門名"
		Worksheets(bunruiCode).Range("J1").Value = "重量単価[初期値]"
		' 2行目
		' 部門コードが入るセルの書式設定を文字列に設定
		Worksheets(bunruiCode).Range("H2").NumberFormatLocal = "@"
		Worksheets(bunruiCode).Range("H2").Value = Worksheets("内生部門").Range("G" & i).Value
		Worksheets(bunruiCode).Range("I2").Value = Worksheets("内生部門").Range("H" & i).Value
	Next
End Sub

セルの書式設定に関する命令文、NumberFormatLocalというものを今回初めて使用しました。

部門コードが転記されるセルの書式を文字列に設定することで、先頭が「0」で始まるコードも「0」が省略されることなく転記することができました。

重量単価の初期値設定(1)と(2)

1)産業内製品の生産単位が全て[t]または[g],[kg]の場合、[g],[kg]は[t]に変換して算出します。算出式は以下のようになります。

Ux = Mx / Tx   (2.1)

Ux : x産業の重量単価[円/t]
Mx : x産業の総生産額[円]
Tx :  x産業の総生産量[t]

ニット生地を例にとって、1)の方法での重量単価[初期値]の設定方法を示すと以下のようになります。

画像2

ニット生地の重量単価[初期値]は、85,840[百万円] ÷ 98,621[t] =885,779[円/t]となります。

重量単価[初期値]の算出が終わったシートはわかりやすいように、緑色にシートの色を変更することにします。

2)産業内製品の生産単位の一部が[t]または[g],[kg]の場合、その一部のみを用いて1)と同じように推計しました。

パルプを例に取って、2)の方法で重量単価[初期値]の設定方法を示すと、以下の表のようになります。

画像3

砕木パルプ以外の製品についてはすべて生産単位が[t]なので、パルプの重量単価は、558,075[百万円] ÷ 8,701,044[t]=64,139[円/t]となります。

重量単価[初期値]の推定が完了したので、パルプのワークシートも緑色に変更します。

学生時代の過ちを繰り返すのか…

とワークシート1枚ずつ、手計算で重量単価[初期値]を算出していたのですが、途中でハッと気づきました。

「学生時代と同じことやっとる!」

というわけで、上述の1)と2)を自動で計算するVBAを組むことにしました。

例のごとく、プログラムを組むことに夢中になって、経過を端折ってます。

Sub 本番用()
	' 重量単価【初期値】を自動計算する
	Dim bunruiCode As String
	Dim totalWeight As Double
	Dim totalPrice As Double
	Dim weightUnitPrice As Double
	For cnt = 10 To 195
		bunruiCode = Worksheets("内生部門").RANGE("G" & cnt).VALUE
		weightUnitPrice = 0
		totalWeight = 0
		totalPrice = 0
		For i = 2 To 1000
			If Worksheets(bunruiCode).Range("C" & i).Value = "t" Then
				totalWeight = totalWeight + Worksheets(bunruiCode).Range("D" & i).Value
				totalPrice = totalPrice + Worksheets(bunruiCode).Range("F" & i).Value
			ElseIf Worksheets(bunruiCode).Range("C" & i).Value = "kg" Then
				totalWeight = totalWeight + Worksheets(bunruiCode).Range("D" & i).Value / 1000
				totalPrice = totalPrice + Worksheets(bunruiCode).Range("F" & i).Value
			ElseIf Worksheets(bunruiCode).Range("C" & i).Value = "g" Then
				totalWeight = totalWeight + Worksheets(bunruiCode).Range("D" & i).Value / 1000000
				totalPrice = totalPrice + Worksheets(bunruiCode).Range("F" & i).Value
			End If
		Next
		If totalWeight = 0 Then
				GoTo Continue
		End If
		weightUnitPrice = totalPrice * 1000000 / totalWeight
		Worksheets(bunruiCode).Range("J2").Value = weightUnitPrice
	Continue:
		Next cnt
End Sub

Goto文を使って擬似的にcontinueする

最初、totalWeightが0のときに、continueするコードを書いておらず、0除算エラーに出くわしました。

グーグル検索した結果、GoTo文を使えば、Pythonのcontinueのようにループを1回スキップできることがわかりました。

が、Continue先の記述(Continue:)がよくわからず、解決に時間を要しました。

また、1つのワークシートで、重量単価[初期値]を算出した後に、totalWeight,totalPrice, weightUnitPriceを0で初期化する必要があることにも、後になってようやく気づきました。

あと、残念なことに、重量単価[初期値]を算出し終えたワークシートのタブの色を緑色に変更するVBAは、LibreOfficeでは未実装ということで実現できませんでした…

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