Excel VBAを使って病名検索ツールを作成する。
まず、図1に検索する病名のデータベース（Excelシート）を示す。
 |
| 図1．病名データベース（Excelのシート） |
データベースはExcelのシートで作成されている。病名検索ツールは、F列に格納された「病名表記」からK列に格納された「ICD11加工」を検索する機能を提供するものとする（実際の業務ではICD10など、より多彩な情報を表示する必要があるが、ここでは病名を検索するという基本的な機能に絞って試作品を開発する）。
VLookup版
病名表記から該当データを検索するのにExcelのVLookup関数を利用するバージョンを図2に示す。
 |
| 図2．VLookupバージョン |
検索ワード（B2セル）に病名（ここでは「咽喉圧挫損傷」と入力している）を入力して［検索］ボタンをクリックするとICD11が表示される。
なお、コマンドボタンはActiveXコントロールで作っている。ActiveXコントロールはメニューから［開発］→［コントロール］→［挿入］をクリックして表示されるメニューから［ActiveXコントロール］の［コマンドボタン］を選択して作成する。
作成したコマンドボタンのプロパティからオブジェクト名を「VLButton」に変更して（プロパティ画面を開くには［コントロール］の［デザインモード］をクリックしてからコマンドボタンを右クリックして表示されるメニューから［プロパティ］を選択する）、ダブルクリックするとVBエディタが開き「VLButton_Click()」Subプロシージャのひな型が現れるので、そこに図3のようなコードを入力する。
Option Explicit ' ' Vlookup ' Private Sub VLButton_Click() Dim query_str As String Dim search_range As Range Dim ICD11_code As String Set search_range = Worksheets("19・20章データベース用").Range("F2:O128") query_str = Me.Cells(2, 2).Value MsgBox query_str ICD11_code = Application.WorksheetFunction.VLookup(query_str, search_range, 6, False) MsgBox ICD11_code Me.Cells(3, 2).Value = ICD11_code End Sub
図3．VLButton_Click()
これはシートモジュールといってシート（図2の「Vloookup」シート）に付属したモジュールで、シートに貼り付けたコマンドボタンなどのGUI部品に対するイベント（クリック時など）に反応するイベントプロシージャなどを書く。図3は検索ボタンをクリックしたときに呼び出されるイベントプロシージャを記述している。以下にこのイベントプロシージャの説明をする。
まず、図1に示す病名データベースの黄色で示した領域「Worksheets("19・20章データベース用").Range("F2:O128")」をRangeオブジェクト型の変数search_rangeに代入する。
次に、セルB2に入力された検索キーワードを文字列型の変数query_strに代入する。そして、 Application.WorksheetFunction.VLookup関数を使って、領域serach_range（の左端列）から文字列query_strに等しい行を検索して、6列目（ICD11加工）を取得して変数ICD11_codeへ代入する。その後、シートのB3セルに出力する。
このように、ExcelのVlookup関数をVBAで用いるには、Application.WorksheetFunctionオブジェクトのVlookupメソッドを利用する。
完全一致検索（ExactMatch）版
VLookup版と同じことをExcelの組み込み関数VLookupを利用しないで行う方法を紹介する（図4）。
 |
| 図4．完全一致検索（ExactMatch）版 |
［検索］ボタン（オブジェクト名：EMButton）をクリックした時のイベントプロシージャを図5に示す。
Option Explicit ' ' ExactMatch ' Private Sub EMButton_Click() Dim query_str As String Dim search_range As Range Dim ICD11_code As String Dim i As Integer Set search_range = Worksheets("19・20章データベース用").Range("F2:O128") query_str = Me.Cells(2, 2).Value MsgBox query_str i = RangeExactMatch(query_str, search_range) MsgBox "i=" & i If i <> -1 Then ICD11_code = search_range.Cells(i, 6).Value MsgBox ICD11_code Me.Cells(3, 2).Value = ICD11_code Else MsgBox "見つかりません" End If End Sub
図5．完全一致検索版のボタンクリック時イベントプロシージャ
検索キーワードquery_strと検索範囲search_rangeを引数にして見つかったらその行番号（1から始まる連番）を返す関数RangeExactMatchの関数定義を図6に示す。
' ' Rangeからkeyを探し出してindexを返す ' Function RangeExactMatch(key As String, Target As Range) As Integer Dim i As Integer For i = 1 To Target.Rows.Count If key = Target.Cells(i, 1).Value Then RangeExactMatch = i Exit Function End If Next RangeExactMatch = -1 End Function
図6．RangeExactMatch関数
RangeExactMatch関数は、検索範囲Targetの行をスキャンして1列目に格納された文字列（Target.Cells(i, 1).Value）が検索キーワードkeyに一致していたら、その行番号 i を戻り値の設定して関数を抜ける。もし、見つからなかったら-1を返す。その場合は図5に示すように「見つかりません」というメッセージを出力する。見つかった場合は「ICD11加工」をセルB3に出力する。
正規表現によるあいまい検索版
ここまでは入力した検索キーワードに完全に一致した病名を検索する処理を行っていたが、ここでは、正規表現を利用してあいまい検索を行う方法について述べる。正規表現とは、例えば「損傷」で終わる病名とか「頸部」で始まる病名、さらには「打撲」を含む病名、さらには「内頚静脈損傷」か「内頚動脈損傷」といった1文字違いの病名を検索するといった、曖昧な文字列にマッチする検索パターンを使って融通の利く検索を行う手法である。VBAで正規表現を利用するにはこのページを参考にするとよいだろう。
正規表現によるあいまい検索版を図7に示す。
 |
| 図7．正規表現によるあいまい検索版 |
図7に示すように検索ワードに「損傷」で終わる文字列を示す検索パターンである正規表現「損傷$」を入力して［検索］ボタン（オブジェクト名：ReButton）をクリックすると、コンボボックス（オブジェクト名：ReComboBox）に該当する病名がが表示され、そのうち一つを選択するとセルB3にICD11が表示される。
これを実現するVBAのプログラムを図8に示す（シートモジュール）。
Option Explicit ' ' 正規表現 ' Dim token() As String Dim search_range As Range Private Sub ReButton_Click() Dim query_str As String Dim i As Integer Dim results As String Dim cbox As ComboBox Set cbox = Me.ReComboBox cbox.Clear Set search_range = Worksheets("19・20章データベース用").Range("F2:O128") query_str = Me.Cells(2, 2).Value MsgBox query_str results = ReMatch(query_str, search_range) MsgBox results token = Split(results, ",") For i = LBound(token) To UBound(token) 'MsgBox "token(" & i & ")=" & token(i) cbox.AddItem search_range.Cells(token(i), 1).Value Next End Sub Private Sub ReComboBox_Click() Dim ICD11_code As String ICD11_code = search_range.Cells(token(Me.ReComboBox.ListIndex), 6).Value MsgBox "Click:" & Me.ReComboBox.Value & "," & Me.ReComboBox.ListIndex & "," & ICD11_code Me.Cells(3, 2).Value = ICD11_code End Sub
図8．正規表現による曖昧検索
図8は2つのイベントプロシージャからなる。一つは［検索ボタン］をクリックしたときのイベントプロシージャReButton_Click()で、もう一つはコンボボックスをクリックしたときに呼び出されるイベントプロシージャReComboBox_Click()である。後者は実質的にコンボボックスに表示された病名候補を選択したときに実行されるイベントプロシージャである。
［検索ボタン］をクリックしたときは、第1引数に検索文字列（ここには正規表現の検索パターンがセットされる）、第2引数に検索範囲が設定され関数ReMatchを呼び出す。関数ReMatchは正規表現を用いて検索パターンにマッチする病名が格納されている行番号を返す（図9）。
' ' Rangeからkeyを探し出してindexを返す(正規表現) ' Function ReMatch(key As String, Target As Range) As String Dim re As New VBScript_RegExp_10.RegExp Dim i As Integer Dim str As String re.Global = True re.IgnoreCase = True re.Pattern = key str = "" For i = 1 To Target.Rows.Count If re.test(Target.Cells(i, 1).Value) Then Debug.Print i, Target.Cells(i, 1).Value str = str & IIf(str = "", "", ",") & i End If Next ReMatch = str End Function
図9．正規表現を使った検索ReMatch関数
VBAで正規表現を利用するにはRegExpオブジェクトを利用する。そのためにはVBエディタのメニューから［ツール］→［参照設定］を選んで表示される［参照可能なライブラリファイル］から「Microsoft VBScript Regular Expression 1.0」をチェックする。図9では変数reがRegExpオブジェクトのインスタンスである。re.Patternに引数で受け取った検索パターン key を設定し、re.testメソッドを使って引数に指定された病名（Target.Cells(i, 1).Value）が検索パターンに一致するかテストし、一致していたらその行番号 i を文字列変数 str にコンマ区切りで追加する。すべての病名をスキャンし終えたところでコンマ区切りで格納された行番号 str を関数の戻り値として設定する。この関数は"1,5,23,..."といった文字列を返し、行番号1, 5, 23, ...に検索パターンに一致する病名が格納されていることを表す。
関数ReMatchで検索パターンにマッチする病名の行番号が得られたら、それらをコンボボックスに追加する。それを行っているのが図8のForループである。関数ReMatchが返してきた行番号を一つずつ取り出し（token(i)）、それを使って病名（search_range.Cells(token(i), 1).Value）をコンボボックス cbox に AddItemメソッドで追加しています。
コンボボックスから病名が選択されたら図8のReComboBox_Clickプロシージャが呼び出される。ActiveXコントロールのコンボボックスオブジェクトには選択された項目のインデックス（0から始まる）がListIndex属性に設定されるので、これを行番号配列 token のインデックスとして使用し、検索範囲 search_range からICD11を得てセルB3に出力する。
なお、検索対象 search_range と行番号配列 token は異なるプロシージャにまたがって使用されるのでプロシージャ外にグローバル変数として定義している。
0 件のコメント:
コメントを投稿