今回はちょっとしたユーザー定義関数を作ったので紹介します。
概要
突然だが、世の中には地図データ（地形データ）というものがある。
現実世界に存在するあらゆる構造物を表現している地図データは非常に重たいため、領域を一定のサイズで分割した「図郭」という単位でファイル化するという考え方に基づく形式だ。
代表的なのは国土地理院の拡張DM形式など。
http://club.informatix.co.jp/?p=1293
この「図郭」の切り方は図面の製作者が自由に決めることが出来るので、状況に応じて適した切り方をする。
そして、時には図郭番号がランダムで配置されることもある。
（と言っても、飛び飛びというだけで、完全にバラバラというデータは見たことがないが）
身近な例で言うと、住宅地図の索引図をイメージしてもらうと良いかもしれない。
（最初の方のページの、市町村全域の図に網目状の枠を切ってページ番号を振った目次）
あれは街の形に合わせて白紙になる部分の図郭は飛ばしていたりする。
図郭データを表に起こすとこんな感じになる。
重複しない図郭番号があり、それぞれの図郭の左下座標XYと右上座標XYがある。
| 図郭番号 | MIN-X | MIN-Y | MAX-X | MAX-Y |
|---|---|---|---|---|
| A01 | -58,000 | -66,000 | -56,000 | -64,500 |
| A02 | -56,000 | -66,000 | -54,000 | -64,500 |
| A03 | -54,000 | -66,000 | -52,000 | -64,500 |
| A04 | -52,000 | -66,000 | -50,000 | -64,500 |
| B01 | -50,000 | -66,000 | -48,000 | -64,500 |
| B02 | -58,000 | -67,500 | -56,000 | -66,000 |
| B03 | -56,000 | -67,500 | -54,000 | -66,000 |
| B04 | -54,000 | -67,500 | -52,000 | -66,000 |
| B05 | -52,000 | -67,500 | -50,000 | -66,000 |
| B06 | -50,000 | -67,500 | -48,000 | -66,000 |
ちなみにこういうデータはテーブルで定義しておくと作業がしやすくなる。
今回の課題は、膨大な量のポイント（XY）が、どの図郭に属するのかを調べたいということだった。
（適当に電柱１本１本の座標だとでもイメージしてくれれば良い。）
| ID | X | Y | 図郭番号 |
|---|---|---|---|
| 1 | -54636.7 | -70293.2 | ？ |
| 2 | -52646.4 | -69103.2 | ？ |
| 3 | -52660 | -69103.2 | ？ |
| 4 | -54322.5 | -68203.2 | ？ |
| 5 | -54313.9 | -68226.2 | ？ |
| 6 | -47476.4 | -70031.3 | ？ |
| 7 | -47474.9 | -70014.8 | ？ |
| 8 | -47473.4 | -70019.3 | ？ |
こんなのはVBAを回せば簡単なのだが、今回は敢えてExcelのユーザー定義関数を作り、ユーザー側が自由に呼び出して使える仕組みを作ることにした。
完成品
'XYが何行目のRect(XY1,XY2)に属するか特定する 'Match関数と同様に、最初に条件を満たした項目を返す Function MatchRectangle(FindX As Double, FindY As Double, _ DataXYXY As Variant) As Long Const MinX = 1 Const MinY = 2 Const MaxX = 3 Const MaxY = 4 'Range.Valueを二次元配列にキャッシュする Static adr As String Static data As Variant If TypeName(DataXYXY) = "Range" Then If adr <> DataXYXY.Address Then adr = DataXYXY.Address data = DataXYXY.Value End If Else adr = "" data = DataXYXY '←ロスが多い。要改善 End If 'ポイントが何番目の図郭内に存在するか調べる Dim i As Long For i = 1 To UBound(data) If data(i, MinX) <= FindX And FindX <= data(i, MaxX) Then If data(i, MinY) <= FindY And FindY <= data(i, MaxY) Then MatchRectangle = i Exit For End If End If Next End Function
使い方
ワークシート上のポイント一覧に、以下のような数式を追加して対応する。
=MatchRectangle([@X],[@Y],TBL_DATA[[MIN-X]:[MAX-Y]])
これだけだと要素番号が返るだけなので、INDEX～MATCHと同じ使い方をする。
=INDEX(TBL_DATA[図郭番号],MatchRectangle([@X],[@Y],TBL_DATA[[MIN-X]:[MAX-Y]]))
これで、ポイント（XY）が、どの図郭に属しているかを知ることが出来る。
※複数一致には対応していない。最初にヒットした１つ目となる。
解説
MatchRectangleの概要
今回の関数MatchRectangleは、ワークシート関数MATCHの考え方を採用している。
Function MatchRectangle(FindX As Double, FindY As Double, DataXYXY As Variant) As Long
検索条件：FindX、FindY（実数値）
検索範囲：DataXYXY （X最低値、Y最低値、X最高値、Y最高値の順に並んだ二次元配列）
戻り値：一致したDataXYXYの行方向要素番号。該当なしは0
ただし、MATCHにあるような、完全一致、昇順・降順は必要ないので省略した。
検索部分
プログラム終盤の検索部分は何も難しくないと思う。
'Dataを行方向に検索 For i = 1 To UBound(data) 'FindXが現在の行のX最低値～X最高値に収まるか？ If data(i, MinX) <= FindX And FindX <= data(i, MaxX) Then 'FindYが現在の行のY最低値～Y最高値に収まるか？ If data(i, MinY) <= FindY And FindY <= data(i, MaxY) Then '条件を満たした行要素番号を返す MatchRectangle = i '最初にヒットした行で確定 Exit For End If End If Next
- 全ての図郭データに対して
- 検索対象のXが、ある図郭の最低値～最高値に収まるか
- 検索対象のYが、ある図郭の最低値～最高値に収まるか
- 最初にヒットした図郭で行要素番号を確定する
検索において必要となるのが二次元配列データdataだが、それは直前のキャッシュ部分でデータを格納している。
キャッシュ部分
序盤のこちらが、今回みせておきたかった部分。Staticの活用方法でもある。
'Range.Valueを二次元配列にキャッシュする Static adr As String Static data As Variant 'DataXYXYの型がRangeでない＝二次元配列 If TypeName(DataXYXY) <> "Range" Then 'アドレス無効化 adr = "" '引数の配列を検索作業変数にコピー data = DataXYXY '←ロスが多い。要改善 'DataXYXYの型がRange Else 'Rangeのアドレスがキャッシュと異なる If adr <> DataXYXY.Address Then 'アドレスとデータをキャッシュに格納 adr = DataXYXY.Address data = DataXYXY.Value 'Rangeのアドレスがキャッシュと一致した Else 'キャッシュを使うのでコピー不要 End If End If
最初のIFではDataXYXYの二次元配列がどのようなデータかで分岐している。
DataXYXYがRange型でない場合は、Variant(,)型の二次元配列だと考えられる。
※例外処理は省略
ここではとある事情により、二次元配列を検索用変数にコピーしているが、特に大したことはせず素通りする。
Range型の場合は、セル範囲を指定しているということになる。
そもそも、今回のMatchRectangle関数の実行が1回で済むことは考えられない。
なぜなら、膨大なポイントXYデータを、二次元配列と照合させたいからだ。
すると処理速度のボトルネックとなるのが、セルへのアクセスである。
これを高速化するために行っているのが、Static型変数へのキャッシュということになる。
ここで悪い例をお見せしよう
Function 悪いMatchRectangle(FindX As Double, FindY As Double, _ DataXYXY As Variant) As Long Dim num As Long If TypeName(DataXYXY) = "Range" Then num = DataXYXY.Count Else num = UBound(DataXYXY) 'Dataを行方向に検索 Dim i As Long For i = 1 To DataXYXY.Count If DataXYXY(i, 1) <= FindX And FindX <= DataXYXY(i, 3) Then If DataXYXY(i, 2) <= FindY And FindY <= DataXYXY(i, 4) Then 悪いMatchRectangle = i Exit For End If End If Next End Function
この例では、引数で受け取った二次元配列dataを変換せず直接比較させている。
Variantで受け取った場合は問題ないのだが、Rangeの場合は話は別。
If data(i, 1) <= FindX And FindX <= data(i, 3) Then
の部分は
If data(i, 1).Value <= FindX And FindX <= data(i, 3).Value Then
と書いているのと変わらない。
つまりDataXYXYの件数が100件、対象のデータ量が1万件だとして、セルにアクセスする回数は最悪は400万回ということになる。
こんなのを埋め込んだらExcelがカクカクになってしまう。
対策として一般的なのが、二次元配列（Variant）への代入である。
Function あと一歩なMatchRectangle(FindX As Double, FindY As Double, _ DataXYXY As Variant) As Long 'セルの二次元配列への格納 Dim data As Variant If TypeName(DataXYXY) <> "Range" Then data = DataXYXY Else data = DataXYXY.Value End If 'Dataを行方向に検索 Dim i As Long For i = 1 To UBound(data) If data(i, 1) <= FindX And FindX <= data(i, 3) Then If data(i, 2) <= FindY And FindY <= data(i, 4) Then あと一歩なMatchRectangle = i Exit For End If End If Next End Function
DataXYXYの件数が100件、対象のデータ量が1万件だとして、セルにアクセスする回数は1万回ということになる。
データの件数毎にdata = DataXYXY.Valueが必要なため、どうしても減らすことができない。
これでも先の例に比べればマシだが、まだまだ遅いのである。
ここで、最初の話に戻る。
そもそも、今回のMatchRectangle関数の実行が1回で済むことは考えられない。
なぜなら、膨大なポイントXYデータを、二次元配列と照合させたいからだ。
そして、称号相手の二次元配列は、原則固定である。
つまり、1万回のdata = DataXYXY.Valueは、ずっと同じことをしているのである。無意味だ。
そこでStaticの登場だ。
Static変数はプロシージャが終了しても変数が初期化されないという仕様があるため、直前に代入されたデータを保持することが出来る。
でもDataXYXYのセル参照が直前と同じかなんて、証明のしようがない。
そのためadr = DataXYXY.Addressで直前のセル範囲のアドレスをStaticで保持させた。
adrが変化した場合は、キャッシュの更新data = DataXYXY.Valueを実施する。
adrが変化しない場合は、ボトルネックな部分は省略して、いきなり検索に入ることが出来る。
'Rangeのアドレスがキャッシュと異なる If adr <> DataXYXY.Address Then 'アドレスとデータをキャッシュに格納 adr = DataXYXY.Address data = DataXYXY.Value 'Rangeのアドレスがキャッシュと一致した Else 'キャッシュを使うのでコピー不要 End If
まとめ
ユーザー定義関数の強みは、ワークシートのレイアウトと、VBAのロジックを完全に切り離して考えることが出来る点にある。
ユーザーはVBAが使えない人でも好きな場所で好きなように使うことが出来るし、開発者は何番目のセルのデータを読んで、何番目にセルを書き出して・・・セルの結合に備えて・・・と例外を意識しなくてすむ。
（実際には自分で作って自分で使うのだが）
個人用マクロ「PERSONAL.XLSB」に関数を記載しても使えないが、アドイン*.xlamで保存すれば、外部のブックからユーザー定義関数を呼び出して使うことも出来るので、本体のブックは*.xlsxにすることも出来る。
欠点はなんと言っても「重い」ということだろう。
今回のプログラムでも10万件に対して行うと数秒間エクセルがフリーズする。さらにエクセルの動きが全体的にもっさりする。
また、エクセルがクラッシュする原因となりやすい気がする。
私は結構使うが、正直に言うとあまり使うのはあまりオススメできない。
利用はかなり限定的にしておくか、人に渡す時は値として貼り付けをして確定しておくように心がけて使ってもらいたい。
以上
何か御座いましたらコメント欄、またはTwitterからどうぞ♪
それではまた来週♪ ちゅんちゅん(・8・)
