2019年の熱中症搬送人員数の予測と実際をEXCELの組み合わせグラフで描く

　これまでの記事で日最高気温と平均水蒸気圧，各都道府県65歳以上人口および月から熱中症の搬送人員数を予測する回帰式の回帰係数を推定してきた．

　今回はその回帰式を元に実際のデータと比較してみたい．対象は2019年の47都道府県とする．

クエリ

　下記クエリを発行してSQL Serverからデータを抽出する．結果をEXCELにコピペしてテーブル化する．

USE HeatStrokeDB;
GO
SELECT	Year(H.日付)	AS Year
,	MONTH(H.日付)	AS Month
,	H.日付	AS Date
,	P.都道府県コード	AS PrefCode
,	P.都道府県	AS Pref
,	T.日最高気温	AS Temp
,	V.日平均蒸気圧	AS Vapor
,	P.[15歳未満人口]	AS Pop14
,	P.[15～64歳人口]	AS Pop14_65
,	P.[65歳以上人口]	AS Pop65
,	H.[搬送人員（計）]	AS Num
,	CAST(EXP(-21.43 + 0.2858 * T.日最高気温 + 0.08022 * V.日平均蒸気圧 - 0.3035 * MONTH(H.日付) + LOG(P.[15歳未満人口] + P.[15～64歳人口] + P.[65歳以上人口])) AS int)	AS MODEL1
,	CAST(EXP(-20.50 + 0.2850 * T.日最高気温 + 0.08056 * V.日平均蒸気圧 - 0.2976 * MONTH(H.日付) + LOG(P.[15歳未満人口] + P.[65歳以上人口])) AS int)	AS MODEL2
,	CAST(EXP(-20.11 + 0.2844 * T.日最高気温 + 0.08155 * V.日平均蒸気圧 - 0.2957 * MONTH(H.日付) + LOG(P.[65歳以上人口])) AS int)	AS MODEL3
FROM	dbo.T_HeatStroke	AS H
INNER	JOIN	dbo.T_MaxTemperature	AS T
ON	H.都道府県コード = T.都道府県コード
AND	H.日付 = T.年月日
INNER	JOIN	dbo.T_VaporPressure	AS V
ON	H.都道府県コード = V.都道府県コード
AND	H.日付 = V.年月日
INNER	JOIN	dbo.T_Population	AS P
ON	H.都道府県コード = P.都道府県コード
AND	YEAR(H.日付) = P.調査年
ORDER	BY	H.都道府県コード, H.日付

VBAでグラフ作成

　下記コードを実行する．

Option Explicit

Sub makechart()

Dim mySh1   As Worksheet
Dim mySh2   As Worksheet

Set mySh1 = Worksheets("Sheet1")
Set mySh2 = Worksheets.Add

Dim myLstObj As ListObject

Set myLstObj = mySh1.ListObjects(1)

Dim myRng1  As Range
Dim i       As Long
Dim Cht     As Chart

Dim j       As Long
Dim myXValue()  As Date
Dim myValue1()  As Integer
Dim myValue2()  As Integer

Dim SeriesM As Series
Dim SeriesR As Series
Dim myPref  As String

With mySh2
    For i = 1 To 47
        Set Cht = .Shapes.AddChart2(XlChartType:=xlColumnClustered, _
                                           Left:=200 * ((i - 1) Mod 6), _
                                            Top:=200 * ((i - 1) \ 6), _
                                          Width:=200, _
                                         Height:=200).Chart
        With myLstObj
            .Range.AutoFilter field:=1, Criteria1:="2019"
            .Range.AutoFilter field:=4, Criteria1:=i
            Set myRng1 = Intersect(.DataBodyRange, _
                                   .Range.SpecialCells(xlCellTypeVisible))
            myPref = myRng1.Cells(1, 5)
            For j = 0 To myRng1.Rows.Count - 1
                ReDim Preserve myXValue(j)
                ReDim Preserve myValue1(j)
                ReDim Preserve myValue2(j)
                
                myXValue(j) = myRng1.Cells(j + 1, 3)
                myValue1(j) = myRng1.Cells(j + 1, 14)
                myValue2(j) = myRng1.Cells(j + 1, 11)
            Next j
            Set SeriesM = Cht.SeriesCollection.NewSeries
            With SeriesM
                .Name = "Model"
                .XValues = myXValue
                .Values = myValue1
                .ChartType = xlLine
                .Format.Line.Weight = 1#
                '.Format.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent2
            End With
            Set SeriesR = Cht.SeriesCollection.NewSeries
            With SeriesR
                .Name = "Real"
                .XValues = myXValue
                .Values = myValue2
                .ChartType = xlColumnClustered
            End With
            .Range.AutoFilter field:=4
            .Range.AutoFilter field:=1
        End With
        With Cht
            .HasTitle = True
            .ChartTitle.Caption = myPref
            .ChartGroups(1).GapWidth = 0
        End With
    Next i
End With

End Sub

結果

　下図に示す．青の折れ線グラフが予測データ，橙の棒グラフが実際のデータである．予測がうまく行っている県もあれば過小推定，過大推定している県もある．回帰式に取り込めなかった地域差が関係していると思いたい．

まとめ

　最高気温と平均水蒸気圧，都道府県人口および月から熱中症搬送人員数を予測し実際の搬送人員数と比較した．