前回の記事では大正 9 年から平成 17 年までの日本人口総数の年齢階級推移を積み上げ縦棒グラフに描いた．今回は男女別に描く．
テーブルのソート順位に注意
テーブルは前回同様であるが，年度を降順ソートするところが違う．まず年度を降順ソート，ついで生年を降順ソートである．
生年階級のオブジェクトテーマカラー
5 歳階級を 5 系統ごと，つまり 25 年ごとに 1 系統のテーマカラーを割り当てる．詳細はEXCEL VBA から見たオブジェクトテーマカラーと RGB の変換を参照されたい．
コード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 |
Option Explicit Sub MaleFemaleChart() Dim mySht1 As Worksheet Dim mySht2 As Worksheet Dim myLstObj As ListObject Dim myCht1 As Chart Dim myCht2 As Chart Set mySht1 = Worksheets("Sheet3") Set myLstObj = mySht1.ListObjects(1) Set mySht2 = Worksheets.Add(after:=mySht1) Set myCht1 = mySht2.Shapes.AddChart2(Style:=-1, _ XlChartType:=xlBarStacked, _ Left:=0, _ Top:=0, _ Width:=400, _ Height:=400).Chart Set myCht2 = mySht2.Shapes.AddChart2(Style:=-1, _ XlChartType:=xlBarStacked, _ Left:=400, _ Top:=0, _ Width:=400, _ Height:=400).Chart Dim i As Long Dim j As Long Dim myRng As Range Dim FiscalYear() As Long Dim Male() As Long Dim Female() As Long Dim mySeries1 As Series Dim mySeries2 As Series For i = 2005 To 1835 Step -5 With myLstObj .Range.AutoFilter field:=1, Criteria1:=i Set myRng = Intersect(.DataBodyRange, _ .Range.SpecialCells(Type:=xlCellTypeVisible)) If myRng Is Nothing Then Else For j = 0 To myRng.Rows.Count - 1 ReDim Preserve FiscalYear(j) ReDim Preserve Male(j) ReDim Preserve Female(j) FiscalYear(j) = myRng.Cells(j + 1, 2) Male(j) = myRng.Cells(j + 1, 4) Female(j) = myRng.Cells(j + 1, 5) Next j Set mySeries1 = myCht1.SeriesCollection.NewSeries Set mySeries2 = myCht2.SeriesCollection.NewSeries With mySeries1 .Name = i .XValues = FiscalYear .Values = Male End With With mySeries2 .Name = i .XValues = FiscalYear .Values = Female End With End If .Range.AutoFilter field:=1 End With Next i Dim myChtObj As ChartObject Dim myAxis As Axis Dim myChtGrp As ChartGroup 'Debug.Print TypeName(mySht2.ChartObjects) For Each myChtObj In mySht2.ChartObjects 'Debug.Print myChtObj.Parent.Index Set myCht1 = myChtObj.Chart 'Debug.Print myCht1.Name With myCht1 .HasTitle = True With .ChartTitle If myCht1.Name = "Sheet3 グラフ 1" Then .Caption = "男性人口の年齢階級推移" .Left = 0 Else .Caption = "女性人口の年齢階級推移" .Left = 240 End If End With Set myAxis = .Axes(xlCategory) With myAxis .Format.Line.Visible = msoFalse .MajorGridlines.Format.Line.Visible = msoFalse End With Set myAxis = .Axes(xlValue) With myAxis If myCht1.Name = "Sheet3 グラフ 1" Then .ReversePlotOrder = True End If .DisplayUnit = xlTenThousands .Format.Line.Visible = msoFalse .MaximumScale = 75000000 .MajorUnit = .MaximumScale / 3 .MajorGridlines.Format.Line.Visible = msoFalse With .DisplayUnitLabel .Delete End With End With With .PlotArea .Format.Fill.Visible = msoFalse .Format.Line.Visible = msoFalse .Left = -10 .Width = 400 .Top = 30 .Height = 380 End With With .ChartArea .Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1 .Format.TextFrame2.TextRange.Font.Name = "TimesNewRoman" End With Set myChtGrp = .ChartGroups(1) With myChtGrp .GapWidth = 0 End With For Each mySeries1 In .SeriesCollection With mySeries1 'Debug.Print .Format.Fill.ForeColor.RGB Select Case .Name Case "2020" .Format.Fill.ForeColor.RGB = RGB(218, 227, 243) Case "2015" .Format.Fill.ForeColor.RGB = RGB(180, 199, 231) Case "2010" .Format.Fill.ForeColor.RGB = RGB(143, 170, 220) Case "2005" .Format.Fill.ForeColor.RGB = RGB(47, 85, 151) Case "2000" .Format.Fill.ForeColor.RGB = RGB(32, 56, 100) Case "1995" .Format.Fill.ForeColor.RGB = RGB(226, 240, 217) Case "1990" .Format.Fill.ForeColor.RGB = RGB(197, 224, 180) Case "1985" .Format.Fill.ForeColor.RGB = RGB(169, 209, 142) Case "1980" .Format.Fill.ForeColor.RGB = RGB(84, 130, 53) Case "1975" .Format.Fill.ForeColor.RGB = RGB(56, 87, 35) Case "1970" .Format.Fill.ForeColor.RGB = RGB(255, 242, 204) Case "1965" .Format.Fill.ForeColor.RGB = RGB(255, 230, 153) Case "1960" .Format.Fill.ForeColor.RGB = RGB(255, 217, 102) Case "1955" .Format.Fill.ForeColor.RGB = RGB(191, 144, 0) Case "1950" .Format.Fill.ForeColor.RGB = RGB(127, 96, 0) Case "1945" .Format.Fill.ForeColor.RGB = RGB(251, 229, 214) Case "1940" .Format.Fill.ForeColor.RGB = RGB(248, 203, 173) Case "1935" .Format.Fill.ForeColor.RGB = RGB(244, 177, 131) Case "1930" .Format.Fill.ForeColor.RGB = RGB(197, 90, 17) Case "1925" .Format.Fill.ForeColor.RGB = RGB(132, 60, 12) Case "1920" .Format.Fill.ForeColor.RGB = RGB(242, 242, 242) Case "1915" .Format.Fill.ForeColor.RGB = RGB(217, 217, 217) Case "1910" .Format.Fill.ForeColor.RGB = RGB(191, 191, 191) Case "1905" .Format.Fill.ForeColor.RGB = RGB(166, 166, 166) Case "1900" .Format.Fill.ForeColor.RGB = RGB(127, 127, 127) Case "1895" .Format.Fill.ForeColor.RGB = RGB(242, 242, 242) Case "1890" .Format.Fill.ForeColor.RGB = RGB(217, 217, 217) Case "1885" .Format.Fill.ForeColor.RGB = RGB(191, 191, 191) Case "1880" .Format.Fill.ForeColor.RGB = RGB(166, 166, 166) Case "1875" .Format.Fill.ForeColor.RGB = RGB(127, 127, 127) Case "1870" .Format.Fill.ForeColor.RGB = RGB(242, 242, 242) Case "1865" .Format.Fill.ForeColor.RGB = RGB(217, 217, 217) Case "1860" .Format.Fill.ForeColor.RGB = RGB(191, 191, 191) Case "1855" .Format.Fill.ForeColor.RGB = RGB(166, 166, 166) Case "1850" .Format.Fill.ForeColor.RGB = RGB(127, 127, 127) Case "1845" .Format.Fill.ForeColor.RGB = RGB(242, 242, 242) Case "1840" .Format.Fill.ForeColor.RGB = RGB(217, 217, 217) Case "1835" .Format.Fill.ForeColor.RGB = RGB(191, 191, 191) End Select End With Next mySeries1 End With Next myChtObj End Sub |
結果
男女別にすることで見えてくるものもある．1975 年以降，一貫して少子化が進行している．女性の方が長生きする．日本は「おばあちゃん大国」になる．
少子化の原因は女性が生む子供の数が減ったからではない．母親となりうる年齢の女性が減ったためである．そして，いったん負のスパイラルに陥った人口減少は複利効果で指数関数的に減少していく．それが 1975 年以降続いている長期的なトレンドだ．
少子化対策は必要だ．しかし，それと今後の予測，つまり確実にやってくる未来とは切り離して受け止める必要がある．
