また面倒な統計を見つけてしまった．Power Query に食わせれば早いのかも知れないが，どうにも埒が明かないので手動でデータを整形することになった．頼むから第一正規形で公開してくれ…
データのダウンロード
環境省の鳥獣関係統計
データソースは鳥獣関係統計である．ディレクトリを開くとうんざりする．目的はおそらく 11 番の「狩猟者登録を受けた者による捕獲鳥獣数」という EXCEL のファイルである．これを平成 10 年から平成 28 年までダウンロードする．
EXCEL でのデータクレンジング
時代遅れのレイアウト，ワークシート保護
ファイルを開いてみると，印刷を前提としたレイアウトになっていることが分かる．ご丁寧にセル内スペースが挿入してあるため，検索が効かない．置換しようとするとパスワード付きでワークシートに保護がかかっている．もういい加減，こういうの辞めてほしい．
該当部位をコピペ
セルのコピペは可能だったので新規ワークシートに値貼り付けを行う．
スペース，ゼロ，マイナス記号の削除
検索と置換でそれぞれ削除．スペースがあると検索に引っかからなくなるためである．ゼロとマイナス記号は左外部結合により発生した NULL である．
テキストを手動で整形
犬の道だと分かっている．二度と同じ作業はしないと誓いつつ，SQL Server にインポートするためのテキストづくりと割り切って作業を続行する．修行である．途中からミスが頻発し始め，その日の作業はここまでとした．続きは翌日だ．
ここで記しておくが，今回取り扱った「捕獲数」とは全部が殺処分となった訳ではない．罠，網などで生け捕りにした数も含む「合計」である．元データを確認してほしいが，これには捕獲年月日や捕獲場所の情報がない．あくまでも年間の集計値である．
例外はクマで，ほぼ全頭が射殺されている．動物倫理とか言うつもりはない．市民の生命に直結する事態であり，やむを得ない措置である．
新規ファイルから「クエリと接続」でインポート
ワークシート 1 枚ごとにインポート
Power Query での作業
ブック内のテーブルを「範囲に変換」
ここまで来てようやく VBA の出番となる．下記コードを標準モジュールから実行してすべてのテーブルをセル範囲に変換する．これは使い捨てのコードなので保存しなくて良い．
Sub UnList()
Dim mySht As Worksheet
Dim myLstObj As ListObject
For Each mySht In Worksheets
If mySht.ListObjects.Count > 0 Then
Set myLstObj = mySht.ListObjects.Item(1)
With myLstObj
.UnList
End With
End If
Next mySht
End Sub
全データを 1 枚のワークシートに集め，テーブルに変換
コピペでデータを 1 枚のワークシートに集める．コピー元のワークシートは削除する．それをテーブルに変換する．
年度を年末日に変換
A 列の「年度」は後々何かと使いにくいため，年末日に変更しておく．下記の数式を挿入する．
=DATEVALUE(LEFT([@年度],5)&"12月31日")
これでピボットテーブルや各種グラフなどに応用しやすくなる．該当列をコピーして値貼り付けで参照関係を削除しておくのを忘れないように．
テキストファイルに出力
SQL Server にインポートするためにテキストファイルに出力する．
なぜデータベースが必要になるのか？これまで蓄積してきたデータと結合したいからである．リレーショナルデータベースの醍醐味は異なる軸のデータを同じ俎上に載せることにある．
SQL Server での作業
ウィザードを用いてインポート
SQL Server でのインポートのうち最も重要なのが「列マッピング」である．下図を参考に変換先の列名，データ型，NULL 値の使用，サイズを変更しておく．
クエリ
ここではクマ，イノシシ，シカ，サルを抽出したい．代表的な獣害がこの野生動物だからである．ワイルドカードを使って対象を絞り込んでいく．
クマを抽出
北海道はヒグマ，本州以南ではツキノワグマである．両者を抽出したい．まず下記のクエリを書いた．
SELECT * FROM dbo.T_CapturedAnimals as CA WHERE CA.Animals like '%グマ';
(1390 行処理されました)
これだとその他にアライグマやアナグマも引っかかってくる．
SELECT * FROM dbo.T_CapturedAnimals as CA WHERE CA.Animals like '%グマ' AND (LEN(CA.Animals) = 3 OR LEN(CA.Animals) = 6);
(262 行処理されました)
ざっと見たところ，クマはこれで抽出できているようだ．
イノシシを抽出
SELECT * FROM dbo.T_CapturedAnimals as CA WHERE CA.Animals like '%イノシシ%'
(824 行処理されました)
シカを抽出
SELECT * FROM dbo.T_CapturedAnimals as CA WHERE CA.Animals like '%ジカ%';
(1564 行処理されました)
サルを抽出
不思議なことに，サルが抽出されてこない．
SELECT * FROM dbo.T_CapturedAnimals as CA WHERE CA.Animals like '%サル';
(0 行処理されました)
テーブルにも元の EXCEL ファイルにもサルのデータが存在しない．どうやらサルは駆除の対象から外れているらしい．
環境省特定鳥獣保護・管理計画作成のためのガイドライン（ニホンザル編・平成27年度）によると，駆除ではなく「防除」と呼ぶらしく，ガイドライン中に 88 回出現する．「捕獲」は 274 回出現し，「殺」という文字は 4 回（殺処分 3 回，捕殺 1 回）出現する．
殺処分に至るにはフローチャートがある．加害レベルが 0 から 5 まで 6 段階あり，捕獲は加害レベル 2 からである．加害レベルが上がるにつれて群れのサイズと配置が大きくなり，選択捕獲，部分捕獲，群れ捕獲と対応が強化されていく．
クマ，イノシシ，シカを抽出
サルを除いた上記 3 種の動物を抽出するクエリは以下の通りである．
SELECT CA.PrefCode , CA.Prefecture , CA.YEAR , SUM(CASE WHEN CA.Animals like '%グマ' AND (LEN(CA.Animals) = 3 OR LEN(CA.Animals) = 6) THEN CA.Number ELSE 0 END) AS 'クマ' , SUM(CASE WHEN CA.Animals like '%イノシシ%' THEN CA.Number ELSE 0 END) AS 'イノシシ' , SUM(CASE WHEN CA.Animals like '%ジカ%' THEN CA.Number ELSE 0 END) AS 'シカ' FROM dbo.T_CapturedAnimals as CA GROUP BY CA.PrefCode, CA.Prefecture, CA.YEAR ORDER BY CA.PrefCode, CA.YEAR;
(892 行処理されました)
おまけ
一部のデータで PrefCode の先頭のゼロが欠損していた．それを修正するクエリである．
UPDATE T_CapturedAnimals SET PrefCode = '0' + PrefCode WHERE LEN(PrefCode) = 1;
(78 行処理されました)
ヘッダー付きでコピーし EXCEL に貼り付け
クエリの結果を右クリックから「ヘッダー付きでコッピー」し EXCEL の新規ワークシートに貼り付ける．EXCEL のおせっかい機能により PrefCode の先頭のゼロが再び消える．今回は次に述べるコードでループカウンタと照合するため，このままにしておく．
EXCEL でチャートの作成
捕獲場所のジオデータを公開せよ
現地の市民にしてみれば「あそこの地域だな」と見当がつくだろう．
しかし，環境省が年間の都道府県別の集計値しか公表していないので，市区町村レベルでの捕獲数が不明であり，これは粒度が荒すぎると思う．日時も不明だ．
もっと言えば，捕獲場所のジオデータが欲しい．経度と緯度，可能なら高度も必要だ．このデータがないと正確なマッピングができない．猟友会の協力が不可欠と思われるが，環境省には捕獲場所の経度と緯度の報告を義務づけてもらいたい．
チャート作成の実際
文句を言っていても仕方がないので手元のデータからチャートを作っていく．都道府県別，動物別の捕獲数の推移を示したい．
時系列で推移を示すのは折れ線グラフ
テーブルを見れば見当がつくと思うが，1 つのチャートにデータ系列は 3 つの折れ線グラフとなる．ある年だけを取り出すなら地図上に立体の棒グラフを立てるのも視覚効果として有効だ．
今回は折れ線グラフで行くことにする．
VBA での記述
細かいことはいい．下記コード参照のこと．
Sub CapturedAnimals()
Dim mySht1 As Worksheet
Dim mySht2 As Worksheet
Dim myLstObj As ListObject
Dim myRng1 As Range
Dim myRngYear As Range
Dim myRngBear As Range
Dim myRngDeer As Range
Dim myRngBoar As Range
Set mySht1 = Worksheets("Sheet2")
Set mySht2 = Worksheets("Sheet3")
Set myLstObj = mySht1.ListObjects(1)
Dim i As Long
Dim j As Long
Dim myCht As Chart
Dim myPref As String
Dim SeriesBear As Series
Dim SeriesDeer As Series
Dim SeriesBoar As Series
Dim myYear() As Long
Dim myBear() As Long
Dim myDeer() As Long
Dim myBoar() As Long
For i = 1 To 47
Set myCht = mySht2.Shapes.AddChart2(Style:=-1, _
XlChartType:=xlLine, _
Left:=200 * ((i - 1) Mod 6), _
Top:=200 * ((i - 1) \ 6), _
Width:=200, _
Height:=200).Chart
With myLstObj
.Range.AutoFilter field:=1, Criteria1:=i
Set myRng1 = Intersect(.DataBodyRange, _
.Range.SpecialCells(Type:=xlCellTypeVisible))
Set myRngYear = Intersect(.DataBodyRange, _
.Range.SpecialCells(Type:=xlCellTypeVisible), _
.ListColumns("YEAR").Range)
Set myRngBear = Intersect(.DataBodyRange, _
.Range.SpecialCells(Type:=xlCellTypeVisible), _
.ListColumns("クマ").Range)
Set myRngDeer = Intersect(.DataBodyRange, _
.Range.SpecialCells(Type:=xlCellTypeVisible), _
.ListColumns("シカ").Range)
Set myRngBoar = Intersect(.DataBodyRange, _
.Range.SpecialCells(Type:=xlCellTypeVisible), _
.ListColumns("イノシシ").Range)
myPref = myRng1.Cells(1, 2).Value
If myRng1 Is Nothing Then
Else
For j = 0 To myRng1.Rows.Count - 1
ReDim Preserve myYear(j)
ReDim Preserve myBear(j)
ReDim Preserve myDeer(j)
ReDim Preserve myBoar(j)
myYear(j) = Year(myRngYear.Cells(j + 1, 1))
myBear(j) = myRngBear.Cells(j + 1, 1)
myDeer(j) = myRngDeer.Cells(j + 1, 1)
myBoar(j) = myRngBoar.Cells(j + 1, 1)
Next j
Set SeriesBear = myCht.SeriesCollection.NewSeries
With SeriesBear
.Name = "熊"
.XValues = myYear
.Values = myBear
End With
Set SeriesDeer = myCht.SeriesCollection.NewSeries
With SeriesDeer
.Name = "鹿"
.XValues = myYear
.Values = myDeer
End With
Set SeriesBoar = myCht.SeriesCollection.NewSeries
With SeriesBoar
.Name = "猪"
.XValues = myYear
.Values = myBoar
End With
End If
.Range.AutoFilter field:=1
End With
Dim myAxis As Axis
Dim mySeries As Series
Dim myPoint As Point
Dim myDataLabel As DataLabel
With myCht
Set myAxis = .Axes(xlCategory)
With myAxis
.Format.Line.Visible = msoFalse
.MajorGridlines.Format.Line.Visible = msoFalse
End With
Set myAxis = .Axes(xlValue)
With myAxis
.Format.Line.Visible = msoFalse
.MajorGridlines.Format.Line.Visible = msoFalse
Select Case .MaximumScale
Case 10 To 25
.MaximumScale = 25
Case 26 To 50
.MaximumScale = 50
Case 51 To 100
.MaximumScale = 100
Case 101 To 250
.MaximumScale = 250
Case 251 To 500
.MaximumScale = 500
Case 501 To 1000
.MaximumScale = 1000
Case 1001 To 2500
.MaximumScale = 2500
Case 2501 To 5000
.MaximumScale = 5000
Case 5001 To 10000
.MaximumScale = 10000
Case 10001 To 25000
.MaximumScale = 25000
Case 25001 To 50000
.MaximumScale = 50000
Case Else
.MaximumScale = 100000
End Select
.MajorUnit = .MaximumScale / 5
End With
.HasTitle = True
With .ChartTitle
.Caption = myPref
.Left = 0
End With
With .PlotArea
.Format.Fill.Visible = msoFalse
.Format.Line.Visible = msoFalse
.Left = -10
.Width = 150
End With
With .ChartArea
.Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.Format.Line.Visible = msoFalse
.Format.TextFrame2.TextRange.Font.Name = "TimesNewRoman"
End With
For Each mySeries In .SeriesCollection
Set myPoint = mySeries.Points.Item(mySeries.Points.Count)
mySeries.HasDataLabels = True
For Each myDataLabel In mySeries.DataLabels
myDataLabel.ShowValue = False
If mySeries.Values(18) > 0 Then
myPoint.DataLabel.ShowSeriesName = True
myPoint.DataLabel.ShowValue = True
End If
Next myDataLabel
Next mySeries
End With
Next i
End Sub
チャート
結果の折れ線グラフを示す．クマは青，シカはオレンジ，イノシシは灰色で示されている．
北海道ではシカの捕獲数が圧倒的だが，クマも相当なものである．全国でイノシシの被害の報告が増えてきたことをデータも支持している．
四国，九州沖縄地方ではクマはほぼ絶滅したと考えられ，捕獲報告はない．
まとめと考察
環境省の捕獲鳥獣数の統計からクマ，イノシシ，シカの捕獲数に限定して都道府県別の折れ線グラフにした．地域によって様相が異なる．
さらに精度の高い野生動物の行動を補足するには，捕獲場所のジオデータ（経度と緯度）と日時のデータが必要と考えられ，猟友会の協力が必要である．
“環境省の捕獲鳥獣数の統計を折れ線グラフにする” への1件の返信