#97　製造業の県内生産額の推計に利用する「出荷」のデータを一括処理

#91から、2015年（平成27年）岩手県における各産業の県内生産額の推計を行ってきました。

ここ最近、特に製造業の県内生産額の推計作業に差し掛かったあたりから、推計作業に飽きてきました。

推計作業手順を振り返ってみる

そこで、改めて推計作業を振り返ってみると、以下のような工程を毎回、手作業で繰り返していることにはたと気づきました。

1. 総務省・経済産業省「平成28年経済センサス‐活動調査 事業所に関する集計 産業別集計 製造業に関する集計」の 表番号 3-4 「品目別、都道府県別の出荷及び産出事業所数（従業者４人以上の事業所）」における岩手県の「出荷額」のデータを表示

2. 上記1.で表示した岩手県の「出荷額」のデータをダウンロード

3. 上記2.でダウンロードした岩手県の「出荷額」のデータのうち、不要な列・行を削除

4. 県内生産額を推計するためのスプレッドシートに手作業でコピー&ペースト

5. 総務省・経済産業省「平成28年経済センサス‐活動調査 事業所に関する集計 産業別集計 製造業に関する集計」の 表番号 3-4 「品目別、都道府県別の出荷及び産出事業所数（従業者４人以上の事業所）」における全国の「出荷額」のデータを表示

6. 上記5.で表示した全国の「出荷額」のデータをダウンロード

7. 上記6.でダウンロードした全国の「出荷額」のデータのうち、不要な列・行を削除

8. 県内生産額を推計するためのスプレッドシートに手作業でコピー&ペースト

9. 「出荷額」の対全国比×平成27年産業連関表（総務省）国内生産額で県内生産額を推計

#6でも触れていた学生時代と同じ過ちを、今回もまたやらかしていると痛感…。

ワークシート1枚ずつ、手計算で重量単価[初期値]を算出していたのですが、途中でハッと気づきました。
「学生時代と同じことやっとる！」

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

一括でできる工程は一括処理

品目ごとにダウンロードしていた工程、つまり、上述の2.と3.及び6.と7の工程

• 「出荷額」のデータのダウンロード

• 不要な列・行を削除

を予め一括でやってしまおうと思います。

また、県内生産額を推計するためのスプレッドシートに転記しやすい状態にもしておこうと思います。

「出荷額」のデータの一括ダウンロードと不要な行・列の削除

出荷額のデータの一括ダウンロード

総務省・経済産業省「平成28年経済センサス‐活動調査 事業所に関する集計 産業別集計 製造業に関する集計」の 表番号 3-4 「品目別、都道府県別の出荷及び産出事業所数（従業者４人以上の事業所）」から、岩手県及び全国の全品目の「出荷額」データを一括でダウンロードします。

不要な行・列の削除

次に、ダウンロードしたファイル内の不要な行・列を削除します。

この段階でのデータの状態は、以下のようになります。

図97−1　「品目別、都道府県別の出荷及び産出事業所数（従業員4人以上の事業所）
の一括ダウンロードと不要な行・列の削除した状態（一部抜粋）

コードと品目名を別々の列に格納

1列目（「H28_製造品目」）には、コードと品目名の両方がくっついた状態で格納されています。

県内生産額を推計するためのスプレッドシートに転記する際、コードと品目名が分かれていた方が、推計計算がしやすいです。

なので、コードと品目名を分けて、それぞれを別の列に格納します。

上記の作業を自動で実行するVBAのコードは、以下のようになります。

Sub 品目コードと品目名を分割して別々の列に格納()
	Dim wsOrg As Worksheet
	Dim wsDes As Worksheet
	Dim i As Integer
	Dim num  As Long
	Dim code As String
	Dim pname As String
	
	Set wsOrg = Workbooks("H28経済センサス_全国_品目別の出荷（従業者４人以上の事業所）.ods").Worksheets("Sheet1")
	Set wsDes = Workbooks("H28経済センサス_全国_品目別の出荷（従業者４人以上の事業所）.ods").Worksheets("Sheet2")
	For i = 2 To 1784
		num = Val(wsOrg.Cells(i, 1).Value)
		If num < 100000 Then
			code = "0" & CStr(num)
		Else
			code = CStr(num)
		End If
		pname = Replace(wsOrg.Cells(i, 1).Value, code, "")
		wsDes.Cells(i, 1).NumberFormatLocal = "@"	' セルの書式を「文字」に設定
		wsDes.Cells(i, 1).Value = code
		wsDes.Cells(i, 2).Value = pname
		wsDes.Cells(i, 3).Value = wsOrg.Cells(i, 2).Value
		wsDes.Cells(i, 4).Value = wsOrg.Cells(i, 3).Value
		wsDes.Cells(i, 5).Value = wsOrg.Cells(i, 4).Value
	Next
End Sub