日本の市区町村の時系列の人口順位をEXCELの散布図に描く

 読者がどの街に住んでいるか,俺は知らない.だが,将来読者の住む街の運命はほぼ確信を持って予言できる.今後しばらく繁栄が続くか,それとも衰退していくのかは,人口から予測できる.今日の記事ではその予測をデータを基に示す.後半は技術的な話題となる.

統計は総務省が公表している

 日本の市の人口順位をEXCELにダウンロードして散布図に描くでも触れたが,日本の人口は 5 年ごとに行う国勢調査を基に総務省が作成している.だが,このデータをもとに全国の都市を一覧できる形で見たことがない.

データビジュアライゼーションが求められている

 最近の BI 界隈ではデータビジュアライゼーションが盛んである.だが,もっと日本の統計を分かりやすい形で解説したものが欲しい.データベースから統計,データビジュアライゼーションに至るまで網羅的に理解し表現できる人材が求められている.

結果

 全国の市区町村は 3000 以上ある.EXCEL のグラフのデータ系列の上限数は 255 であり,すべてを一覧することはできない.そのため,全国を 8 つの地方区分に分け,それぞれの地方ごとに散布図として示した.

 横軸には人口増減率,縦軸には人口(万人)を対数で表している.線でつながった点のひと塊が都市であり,2000 年から 5 年ごとにグラフ上を動き回っている.最後の 2015 年のみ点を少し大きくしてある.

 白色は一般の市区町村,赤色は区を示している.

北海道地方

北海道地方の人口増減率対対数人口の推移(2000-2015年)
北海道地方の人口増減率対対数人口の推移(2000-2015年)

東北地方

東北地方の人口増減率対対数人口の推移(2000-2015年)
東北地方の人口増減率対対数人口の推移(2000-2015年)

関東地方

関東地方の人口増減率対対数人口の推移(2000-2015年)
関東地方の人口増減率対対数人口の推移(2000-2015年)

中部地方

中部地方の人口増減率対対数人口の推移(2000-2015年)
中部地方の人口増減率対対数人口の推移(2000-2015年)

近畿地方

近畿地方の人口増減率対対数人口の推移(2000-2015年)
近畿地方の人口増減率対対数人口の推移(2000-2015年)

中国地方

中国地方の人口増減率対対数人口の推移(2000-2015年)
中国地方の人口増減率対対数人口の推移(2000-2015年)

四国地方

四国地方の人口増減率対対数人口の推移(2000-2015年)
四国地方の人口増減率対対数人口の推移(2000-2015年)

九州・沖縄地方

九州・沖縄地方の人口増減率対対数人口の推移(2000-2015年)
九州・沖縄地方の人口増減率対対数人口の推移(2000-2015年)

原子から国家まで従う「べき乗の法則」

 矢野和男マーク・ブキャナンらが異口同音に述べているが,この世界はべき乗の法則に従う.原子の量子的振る舞いから人の行動,企業や国家,さらには地震や森林火災などの自然現象に至るまで,ありとあらゆるものが「自然に」従うのがべき乗の法則である.

 理屈はさておき,べき乗の法則には一つの特徴がある.

片対数グラフで直線上に乗る

 というものだ.自然現象や企業・国家までもがこの法則に従うのなら,都市だけがその例外でいることはありえない.その目でもう一度上のグラフを見てもらいたい.

 関東や中部,近畿など大都市のある地方は別として,北海道や東北,中国や四国,九州・沖縄地方に共通の特徴が見て取れる.

 右肩上がり(または左肩下がり)である.人の集合である都市もまた組織化されており,自然に臨界状態に置かれている.都市は「自然に」この分布に従う.ほとんどの白い点がこの分布に従っているのが分かる.

例外中の例外

 赤い点は区であり,関東と近畿において右側に大きくはみ出している.これは例外であり,具体的に名前を出せば実感できるだろう.

 右上に向かって伸びつつある都市は例外中の例外である.仙台市青葉区,東京都港区,千代田区,大阪市北区,広島市中区である.

 これらの都市では何らかの強力な誘導が行われているはずだ.指数関数的に人口が増えている(マルサスによる個体数モデル)ということであり,いずれ何らかの制約に突き当たって人口増加率は反転するのか,さらに人口の増加が続くのか興味深い.

 個人的には,資源や居住面積などの物理的制約のためにいずれ人口増加率は反転すると考えている.どんな都市も永久に人口を増やし続けることは不可能だ.いわゆるシグモイド曲線(個体群成長 (Wikipedia))の最も急峻な傾きを見ているに過ぎないという訳である.その形跡は札幌市中央区,東京都練馬区,足立区,江東区,豊島区,中央区,名古屋市中区,神戸市東灘区,大阪市西区,広島市安芸区,福岡市東区などにみられる.

日光市の人口がおかしい?

 関東地方で一つ,人口が 2005 年の 16,379 人から 2010 年の 90,066 人,なんと 6 倍に急増している都市がある.栃木県日光市である.最初,間違いではないかと思った.Wikipedia によると日光市は 2005 年の人口は 94,291 人である.

 実は 2006 年に今市市(62,047 人),日光市の 2 つの市と足尾市,藤原町(10,684 人),栗山村(1,933 人)が合併した.総務省のファイルは間違いではなかった.Wikipedia の日光市の人口のグラフの方がおかしい.

合併しても長期的なトレンドは変わらない

 平成の大合併と言われる市町村合併にも色々ある.しかし,人口減少という長期的なトレンドは押し留めようがない.大半の自治体にとっては人口が減少して税収が維持できなくなると行政サービスの提供に支障が出るため,周辺の自治体と合併して予算規模を維持しようというのがほとんどではないだろうか.

人口の激減している都市

 北海道夕張市.福島県石巻市気仙沼市南相馬市陸前高田市.福島県については東日本大震災および福島第一原発事故の影響が大きい.夕張市は直近ではマイナス 19 % と,自治体としては崩壊しつつあることがデータからも明らかだ.「早く逃げろ」としか言えない.

 大阪市西成区は毎年 8 % ずつ人口が減少している.何かが起きているのかもしれない.

北海道夕張市の直近の人口増減率は-19%
北海道夕張市の直近の人口増減率は-19%

参考図書

散布図を描画する VBA コード

 さて,ここからは技術的な話題になる.これまで述べてきた記事の総括にあたる.

 といった大まかな技術を駆使して緻密な散布図を描くことができた.最初にコードを示そう.

Option Explicit

Sub GetDataSeries()

Dim mySht1      As Worksheet
Dim mySht2      As Worksheet

Dim myRng1      As Range
Dim myRng2      As Range
Dim myRng3      As Range

Dim myLstObj1   As ListObject
Dim myLstObj2   As ListObject

Dim myName      As String
Dim myXValue()  As Double
Dim myValue()   As Long
Dim i           As Integer
Dim j           As Integer

Dim mySht3      As Worksheet
Dim myCht       As Chart
Dim mySeries    As Series
Dim myPoint     As Point
Dim myTitle     As String

Set mySht1 = Worksheets("市区町村マスター")
Set mySht2 = Worksheets("市区町村")

With mySht1.ListObjects
    Set myLstObj1 = .Item(.Count)
End With

With myLstObj1
    .Range.AutoFilter field:=4, Criteria1:="=0", Operator:=xlOr, Criteria2:="=2", Operator:=xlOr, Criteria2:="=3"
    Set myRng1 = Intersect(.DataBodyRange, _
                           .Range.SpecialCells(xlCellTypeVisible), _
                           .ListColumns("都道府県・市区町村コード").Range)
   'Debug.Print myRng1.Address
   .Range.AutoFilter field:=4
End With

With mySht2.ListObjects
    Set myLstObj2 = .Item(.Count)
End With

Set mySht3 = Worksheets.Add
With mySht3
    .Name = "散布図"
    Set myCht = .Shapes.AddChart2(Style:=-1, _
                            XlChartType:=xlXYScatterLines, _
                                   Left:=0, _
                                    Top:=0, _
                                  Width:=400, _
                                 Height:=400).Chart
End With

i = 1
For Each myRng2 In myRng1
    With myLstObj2
        
        .Range.AutoFilter field:=2, Criteria1:=myRng2.Value
        
        Set myRng3 = Intersect(.Range.SpecialCells(xlCellTypeVisible), .DataBodyRange)
       'Debug.Print i, myRng3.Address
        
        On Error Resume Next
        For j = 0 To myRng3.Rows.Count - 1
            ReDim Preserve myXValue(j)
            ReDim Preserve myValue(j)
           'Debug.Print i, j
            myName = myRng3.Cells(j + 1, 6)
            myXValue(j) = myRng3.Cells(j + 1, 10)
            myValue(j) = myRng3.Cells(j + 1, 7)
        Next j
        On Error GoTo 0
        
        'これ以降系列を追加しデータを流し込む処理
        Set mySeries = myCht.SeriesCollection.NewSeries
        With mySeries
            .Name = myName
            .XValues = myXValue
            .Values = myValue
            
            'これ以降全ての系列の書式を設定(色を白に統一,終点のみを別個に指定)する処理
            'https://docs.microsoft.com/ja-jp/office/vba/api/excel.xlrgbcolor
            For Each myPoint In .Points
                With myPoint
                    .MarkerStyle = xlMarkerStyleCircle
                    .MarkerSize = 2
                    If myRng3.Cells(j + 1, 4) = 0 Then
                        .MarkerBackgroundColor = rgbCrimson
                    Else
                        .MarkerBackgroundColor = RGB(255, 255, 255)
                    End If
                End With
            Next myPoint
            
            '最後のPointだけサイズを大きく設定
            '塗りつぶしを背景と同色に,枠線を白に設定
            With .Points(.Points.Count)
                .MarkerSize = 3
                .Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
                .Format.Line.ForeColor.ObjectThemeColor = msoThemeColorBackground1
            End With
            
            'これ以降は線の色と太さを設定
            With .Format.Line
                .Weight = 0.25
                If myRng3.Cells(j + 1, 4) = 0 Then
                    .ForeColor.RGB = rgbCrimson
                Else
                    .ForeColor.RGB = RGB(255, 255, 255)
                End If
            End With
            
        End With
        
        .Range.AutoFilter field:=2
        
    End With
    
   'エラー回避のため系列数を255で止める
    If i = 255 Then Exit For
   'Debug.Print myCht.SeriesCollection(myCht.SeriesCollection.Count).Name
    i = i + 1
    myTitle = myRng2.Offset(, 3).Value
Next myRng2

With myCht
    
    'グラフタイトル
    With .ChartTitle
        .Caption = myTitle
        .Left = 0
    End With
    
    'グラフエリアの塗りつぶしと枠線を設定
    With .ChartArea.Format
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .Line.Visible = msoFalse
        
        'グラフエリアの全てのフォントの色と書体を設定
        With .TextFrame2.TextRange.Font
            .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .Name = "Times New Roman"
        End With
    End With
    
    'X軸の設定
    With .Axes(xlCategory)
        .TickLabels.NumberFormatLocal = "0%"
        .MaximumScale = 0.2
        .MinimumScale = -0.2
        .Crosses = xlAxisCrossesMinimum
        .MajorUnit = 0.1
        .Format.Line.Visible = msoFalse
        '目盛線
        With .MajorGridlines
            .Delete
        End With
        
    End With
    
    'Y軸の設定
    With .Axes(xlValue)
        .ScaleType = xlLogarithmic
        .MinimumScale = 10000
        .DisplayUnit = xlTenThousands
        .Crosses = xlAxisCrossesMinimum
        .MajorUnit = 10
        .Format.Line.Visible = msoFalse
        .HasDisplayUnitLabel = False
        '目盛線
        With .MajorGridlines
            .Delete
        End With
        
    End With
    
End With

End Sub

コードの解説

オートフィルターの結果を取得

 34 – 38 行目でオートフィルターの結果を取得している.ここで重要なのは Intersect 関数と SpecialCells プロパティを使用していることである.

 VBA は手続き型言語であるものの,集合指向のリレーショナルデータベースの概念を取り入れつつあるところである.Intersect 関数は SQL でいうところの AND 演算子にあたり,抽象的な表現では論理積を示している.SpecialCells プロパティは SQL では WHERE 句に該当する.オートフィルター結果を取得するためにやむなく使用しているが,恐らく今後はフィルター結果を直接取得するプロパティが実装されるだろう.そうでなければおかしい.

構造化参照は SQL の SELECT 句

 EXCEL VBA でテーブルのソートを記録するでも述べたが,構造化参照における列指定子はテーブルの列を指定するものであり,SQL でいうところの SELECT 句と同じ働きをしている.

系列をループの中で追加する

 58 – 128 行目は長大なループであるが,その中でも 79 – 117 行目は系列をループの中で追加し,系列の Point オブジェクトと Line オブジェクトの書式を設定している.81 – 83 行目で Series オブジェクトに実データを追加し,87 – 115 行目で書式を設定している.Range オブジェクトを取得しているのが何とも中途半端であるが,仕様なので致し方ない.

グラフのタイトル,グラフエリア, X 軸, Y 軸の書式設定

 130 – 181 行目ではタイトル,グラフエリア, X 軸, Y 軸の書式を設定している.タイトルは 133 – 136 行目,タイトルは 139 – 148 行目, X 軸は 151 – 163 行目, Y 軸は 166 – 179 行目である.

フォントは二つのオブジェクトのせめぎ合い

 初期のバージョンで実装された Font オブジェクトのプロパティには Variant 型で定義されたものが多い.特定のグラフ要素を指定して設定できる.

 一方で中期に実装された Font2 オブジェクトには ChartArea オブジェクト経由で同じグラフ要素にアクセスできるが,設定の及ぶ範囲が広く,オブジェクトを特定して設定ができない.

 過去のバージョンからの一貫性を維持するためにやむなくそうしているのだろうが,開発側としては,早く Font オブジェクトを廃止して Font2 オブジェクトに統一してしまいたいところだろう.

参考書籍

 詳細は EXCEL VBA の参考書籍で述べた.リンクのみ置いておく.

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください