鳥の飛来地をエクセルで集計したい５

Markdown記法を絶賛勉強中の管理人です。こんちくわ｜ω・)ﾉ

シリーズでお伝えしています和歌山県鳥類目録を集計する件です。

このPDFファイルをエクセルにコピペしたら・・
f:id:FukuCyndiP:20190923000938p:plain:w500

こうなったので
f:id:FukuCyndiP:20190923001134p:plain:w500 　

エクセルで集計できるように,VBAでデータを構造化しようというこの企画です。

前々回までの処理で1種1行にまとまった鳥情報を、次は以下の各項目ごとに分割してセルに収めることを目指します

(こうなっているものを)
f:id:FukuCyndiP:20190923163617p:plain:w250

(こうしたい)
f:id:FukuCyndiP:20190927000342p:plain:w500

前回の記事では1行にまとまった鳥情報の中で独自色が強い③と④の情報を利用して、文字列を下記のように加工するための作戦を立てました。そして、そのうち 1. と2. のコードをお示ししたところで力尽きてしまいました。。

実現したい処理

f:id:FukuCyndiP:20190926000134p:plain:w250

作戦

各行に含まれる鳥情報文字列の中で特定の文字が何番目にあるかを返す関数(③④特有文字がどこにあるかを調べる共通プロシージャ)(Function）済
特定の文字を任意の文字に変換する(Sub) 済
③特有文字の横に半角スペースを挿入する(Sub)
④特有文字を境に鳥情報文字列を2つに分割して配列を返す関数(Function)
分割・配列化した文字列をそれぞれ別のセルに出力する(Sub)

と、いうわけで、残りのコードも一気に行きます。

③特有文字の横に半角スペースを挿入する(Sub)

処理のロジックは以下の通り。

鳥情報文字列の中の③特有文字を検索
見つかった特有文字 を (半角スペース)+特有文字 に置換する

Sub InsertSpace(ByVal Target As Range)

  Dim Habitat As Variant
  Habitat = indexInfo(Target, Array("夏", "冬", "旅", "留", "迷", "帰"))(1)

  Call 文字列変換(Target, Habitat, " " & Habitat)
  
End Sub

ポイントは前回の記事で作成した特有文字情報を返す indexInfo() 関数ですね。
この関数の戻り値は配列で、indexInfo(引数1,引数2)(0)：位置とindexInfo(引数1,引数2)(1)：含まれる特有文字 の2つがその中身になります。
ここで変数Habitatには鳥情報の項目③に該当する特有文字が代入されますので、あとはそれをCall 文字列変換()で半角スペース付きに変換します。

④特有文字を境に鳥情報文字列を2つに分割して配列を返す関数(Function)

処理のロジックは以下の通り

鳥情報文字列の中の④特有文字を検索
見つかった文字を境に左側の文字列を配列(0)、右側の文字列を配列(1)に代入

Private Function Devide(ByVal Target As Range) As Variant

  Dim rarityPosition As Variant
  rarityPosition = indexInfo(Target, Array("普", "少", "多", "稀"))(0)
  
  Dim tempArr(1 To 2) As Variant
  tempArr(1) = Left(Target.Value, rarityPosition)
  tempArr(2) = Mid(Target.Value, rarityPosition + 1)
  Devide = Arr

End Function

ここでも indexInfo() 関数が活躍します。
今度は③特有文字を検索してその位置indexInfo()(0)を変数rarityPositionに代入して、次の元の鳥情報文字列を2つに区切る処理に活用します。

因みにMid()関数は第3引数を省略すると、第2引数で与えた位置から残り全部の文字列を返します。

分割・配列化した文字列をそれぞれ別のセルに出力する(Sub)

いよいよ、ワークシート上の鳥情報に目的とする加工(③の横にスペース入れて、④を境に分割)を加える今回の処理のメインプロシージャです。

処理のロジックは以下の通り

鳥情報のあるA列セルオブジェクトを一時変数tempとして上からループ
InsertSpace()プロシージャを呼び出して③特有文字の横に半角スペース導入
Devide()関数を使って、④特有文字を境に分割した文字列配列をtempArrに代入
tempセルに分割した左の文字列tempArr(0)を出力
temp.Offset(0,1)セルに分割後の右の文字列tempArr(1)を出力

Private Sub 観察地とそれ以外を分ける()

  With ws修正データ
    Dim tempArr As Variant
    Dim temp As Range
    For Each temp In .Range("A:A").SpecialCells(xlCellTypeConstants)
      Call InsertSpace(temp)
      tempArr = Devide(temp)
      temp.Value = tempArr(1)
      temp.Offset(0, 1) = tempArr(2)
    Next
  
  End With
End Sub

処理のポイントはこれといってありませんが、あえて挙げるとするならば、④分割後の配列を一時的にtempArr に移している処理でしょうか。
もしかすると、その後のセル出力コマンドでtemp.Value = Devide(.Name, temp)とすれば変数減らせるんじゃね？という疑問が湧くかもしれません。
それでも悪くはないのですが、そう書くと、セルに出力する2つのコマンドで全く同じ処理を2回実行することになりますので、そこは効率性を考えてDivide()関数の結果を一時的な変数に移すことにしました。

それでは今回の処理の実行結果です
f:id:FukuCyndiP:20190930010802p:plain:w500