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割は市街化区域に分布している.今後は人口減少に伴い,下水道によるトイレの水洗化の改善はますます難しくなっていくだろう.


