eStatから日本の資源収支を概略するで概略を取り上げた話題の一つに,トイレ水洗化人口が挙げられる.今回は各都道府県ごとの下水道によるトイレ水洗化人口の人口に占める割合の推移をグラフ化する.
コード
グラフそのものは EXCEL VBA にて描画する.コードを示す.
Option Explicit Sub CreateCharts() Dim mySht1 As Worksheet Dim myCht As Chart Dim i As Long Dim mySht2 As Worksheet Dim myLstObj As ListObject Dim myPref As String Dim myRng1 As Range Dim mySeries As Series Dim myXValue() As Long Dim myValue() As Single Dim j As Long Set mySht2 = Worksheets("Sheet1") Set myLstObj = mySht2.ListObjects(mySht2.ListObjects.Count) Set mySht1 = Worksheets.Add With mySht1 .Name = "都道府県別トイレ水洗化率" For i = 0 To 47 Set myCht = .Shapes.AddChart2(Style:=247, _ XlChartType:=xlXYScatterLines, _ Left:=200 * (i Mod 6), _ Top:=200 * (i \ 6), _ Width:=200, _ Height:=200).Chart With myLstObj .Range.AutoFilter field:=1, Criteria1:=i Set myRng1 = Intersect(.Range.SpecialCells(xlCellTypeVisible), _ .DataBodyRange) For j = 0 To myRng1.Rows.Count - 1 ReDim Preserve myXValue(j) ReDim Preserve myValue(j) myPref = myRng1.Cells(j + 1, 2) myXValue(j) = myRng1.Cells(j + 1, 3) myValue(j) = myRng1.Cells(j + 1, 6) Next j Set mySeries = myCht.SeriesCollection.NewSeries With mySeries .Name = myPref .XValues = myXValue .Values = myValue .MarkerSize = 4 .Format.Line.Visible = msoFalse .Format.Fill.ForeColor.RGB = RGB(255, 255, 255) End With .Range.AutoFilter field:=1 End With With myCht .Axes(xlValue).MaximumScale = 1 .ChartArea.Format.TextFrame2.TextRange.Font.Name = "Times New Roman" End With Next i End With End Sub
結果
結果を示す.都道府県により結果が著しく異なるが,概ね体感とさほど違いはないと思われる.どの都道府県も下水道によるトイレの水洗化は頭打ちになってきていることが見て取れる.政府の指摘通り,下水道は初期投資額が高く,事業期間が長期に渡ることから,下水道事業の予算を確保することは財政的に厳しい地方自治体が多い.また下水道未整備区域の人口の7割は市街化区域に分布している.今後は人口減少に伴い,下水道によるトイレの水洗化の改善はますます難しくなっていくだろう.