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

同僚から借りた "幽遊白書" をうっかり読破してしまい、週末のブログ更新に支障をきたした管理人ですこんちくわ｜ω・)ﾉ

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

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

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

エクセルで集計できるように,VBAで何とかしようというこの企画です。

前回の記事までの処理で、
上のようなわけわからない状態だったものを・

　番号、科名、種名、生態、備考（飛来地など）

として下記のように1種の各情報を1行にまとめることができました。

f:id:FukuCyndiP:20190923005627p:plain:w350

ところでバードウォッチャーではない皆さんにはさっぱり何のことやらな各行の情報ですが、下記ような意味を表しています。

f:id:FukuCyndiP:20190923163617p:plain:w250

このデータを解析しやすいように構造化したいわけですが、これらの情報を下の表のようにをそれぞれ別のセルに分割して整理することが次の目標になります。

f:id:FukuCyndiP:20190927000342p:plain:w450

それで次の作戦ですが、③と④の情報を利用して文字列を加工していきます。

実わ、これらの項目では表記の文字種に限りがあります。
記事の本題からは離れますが、参考のために列挙します。

f:id:FukuCyndiP:20190923175422p:plain:w450
（"普”と"多"は同義で使われていましたが、記録した人の好みで表記が分かれたものと思われます）

項目ごとにユニークな表記文字があるということは以下の法則性を示すことになります

③の項目には "夏" "冬” "旅" "留" "迷“ "帰" のどれかしか入らない。
④の項目も "普" "多" ”少” "稀" のどれかしかない。
(さらに、これらの文字は⑤の項目以外では出現しない)

ですので、現時点で１行にまとまっている文字列の中から③あるいは④特有の文字列を探し出して、そこで区切りをつけやすいように加工します。

具体的には

③特有文字の前にスペースを差し込む
④特有文字の後ろを境に分割して2つのセルに分けて収納する

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

この処理をVBAでやってみよー。
と、いうのがやっとこさ出現した今回の記事の本題になります

この目的を達成するために次のプロシージャを作成しました。

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

文字検索プロシージャで(今回の処理の肝となります)

検索対象文字列の開始位置に最も近い位置にある検索文字情報を戻り値して返すFunctionプロシージャとしました。
ここでは引数Targetに渡された各行の鳥情報文字列を対象として、引数として渡された③または④独自文字に関する情報を配列として返します。

戻り値を配列としたのは、複数ある独自文字のどれがHitするかはそれぞれの鳥情報毎に異なるため、Hit文字の位置とHit文字そのものの2つが戻り値に含まれるようにしたかったためです。
また、独自文字のいくつかは⑤観察場所を示す文字列にも含まれるため、鳥情報の開始位置から最も近い位置に含れるものが戻り値となるようにしました。

そこで、このプロシージャのロジックは、

↓検索対象文字(Target)と候補文字すべて含む配列(Indexes)を引数として受け取る
↓Targetの総文字数を配列(0)の初期値として設定
↓Indexsに含まれる検索文字の文字位置を検索(ループ)
↓Hitしたらその位置を配列(0)と比較
↓Hit位置＜配列(0)ならば、配列(0)の値を更新し、Hitした検索文字を配列(1)に代入
↓(検索文字を変更してループ継続)
↓出来上がった配列を戻り値として設定

となりました。

コードは以下の通り

  Dim temp As Variant
  Dim Position As Long
  Dim tempArr(1) As Variant
  tempArr(0) = Len(Target)
  
  For Each temp In Indexs
    Position = InStr(Target, temp)
    If Position <> 0 Then
      If Position < tempArr(0) Then
        tempArr(0) = Position
        tempArr(1) = temp
      End If
    End If
  Next
  
  If tempArr(0) = Len(Target) Then
    tempArr(1) = ""
  End If
  
  indexInfo = tempArr
End Function

(初のシンタックスハイライト！）

処理のポイントの一つはFor Eachステートメントです。
ループの対象を配列(Indexes)そのものとすることで、そ中身を変数tempに次々代入しながらループします。
InStr(Target, temp) は、”Target” 文字列の中で "temp” に代入された文字の位置を返す関数です。いったん変数 "Position" に格納しておいて、tempArr(0)と比較しながらループを回して、最小（対象文字列の開始位置にもっとも近い位置)が最終値としてtempArr(0)に代入されるようにします

(テストコードで④特有文字の検索テスト)

f:id:FukuCyndiP:20190929003732p:plain

テスト鳥情報にはわざと④特有文字を2つ入れてみましたが、惑わされることなく鳥情報文字列の開始位置から一番近いところにある④特有文字とその位置を返していますね。

特定の文字を任意の文字に変換するプロシージャ

これわなんてことはないただの置換なのですが、各鳥情報の表記ゆれを修正するために多用することになったため、コードの可読性を観点であえて別プロシージャとして独立させることにしました。

Private Sub 文字列変換(ByVal Target As Range, ByVal From_ As String, ByVal To_ As String)

    Target.Replace What:=From_, Replacement:=To_, LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

End Sub