ワークシート内のセルを検索してDictionaryオブジェクトに蓄積する関数

  • 2
    Like
  • 0
    Comment

FindCells関数の説明

下に示すプログラムFindCells関数は、引数のワークシートTargetWorksheetの全てのセルを対象に、文字列SearchTextと完全一致するセルを検索してDictionaryオブジェクトにまとめて返します。

検索対象のセルが見つかると、セルのアドレスをKey、セルのRangeオブジェクトをItemとしてDictionaryオブジェクトに追加しています。Countプロパティの値は見つかったセルの個数です。

標準モジュール
' TargetWorksheet内の全てのセルを対象に、SearchTextと完全一致するセルを検索する
' 戻り値のDictionaryオブジェクトは、KeyがセルのアドレスでItemがRangeオブジェクトの集合
' セルが見つからない場合は空(Count = 0)のDictionaryオブジェクトとなる
Function FindCells(ByRef TargetWorksheet As Worksheet, ByRef SearchText As String) As Dictionary

  Dim FoundCell As Range

  Set FindCells = New Dictionary

  ' TargetWorksheet内でSearchTextと完全一致する最初のセルを探す
  Set FoundCell = TargetWorksheet.Cells.Find(What:=SearchText, LookIn:=xlValues, LookAt:=xlWhole)

  ' セルが見つかった場合は2つ目以降を探す
  If Not FoundCell Is Nothing Then
    Do
      If Not FindCells.Exists(FoundCell.Address) Then
        FindCells.Add FoundCell.Address, FoundCell
        ' FindNextはセルを探し終わると最初のセルに戻って検索し続ける
        Set FoundCell = TargetWorksheet.Cells.FindNext(FoundCell)
      Else
        Exit Do
      End If
    Loop
  End If

  Set FoundCell = Nothing

End Function

Dictionaryオブジェクトを使うための参照設定

Dictionaryオブジェクトを使うので、VBAのIDE(ExcelワークブックからAlt+F11で開く画面)のツール > 参照設定をクリックして、Microsoft Scripting Runtimeにチェックを入れます。もし、ワークブックを新規作成したら参照設定も初期化されているので、使いたいライブラリにはワークブック単位で参照設定をする必要があります。

20170816-ref-setting.jpg

Microsoft Scripting Runtimeの参照設定をしないと「コンパイルエラー: ユーザー定義型は定義されていません」というエラーになります。

20170816-compile-error.jpg

FindCells関数の使い方

このFindCells関数の使い方を説明します。

今、シート名Sheet1のワークシートに "検索テスト" という値のセルを3つ用意しました。セルのアドレスは、B2、C11、E6です。

20170816-search-test.jpg

そこで、これらのセルを検索するにはFindCells関数を次のように使います。

標準モジュール
Sub Test_FindCells()

  Dim FoundCellSet As Dictionary
  Dim CellAddress  As Variant

  Set FoundCellSet = FindCells(ThisWorkbook.Sheets("Sheet1"), "検索テスト")

  ' 見つかったセルのワークシート名とアドレスを表示する
  For Each CellAddress In FoundCellSet
    Debug.Print FoundCellSet(CellAddress).Worksheet.Name, FoundCellSet(CellAddress).Address
  Next

  Set FoundCellSet = Nothing

End Sub

実行後の出力をキャプチャしました。

20170816-immediate-window.jpg

Dictionaryオブジェクトはすごく便利ですが、そのままではインテリセンスが機能しません。例えば、上記のテストだと、見つかったセルはFoundCellSet(CellAddress)がオブジェクトとなっているのですが、FoundCellSet(CellAddress).としてもRangeオブジェクトのメソッドとプロパティが表示されません。

インテリセンスを機能させたいなら、次のようにDictionaryオブジェクトのメンバーをRangeオブジェクトにセットし直します。

標準モジュール
Sub Test_FindCells2()

  Dim FoundCellSet As Dictionary
  Dim CellAddress  As Variant
  Dim FoundCell    As Range

  Set FoundCellSet = FindCells(ThisWorkbook.Sheets("Sheet1"), "検索テスト")

  ' 見つかったセルのワークシート名とアドレスを表示する
  For Each CellAddress In FoundCellSet
    Set FoundCell = FoundCellSet(CellAddress)
    Debug.Print FoundCell.Row
  Next

  Set FoundCellSet = Nothing

End Sub

こうすると、インテリセンスが機能します。

20170816-intellisence.jpg

ワイルドカードで入力があるセルを全て検索する

Set FoundCellSet = FindCells(Sheet1, "*")

とすると、ワークシート1Sheet1内の入力がある全てのセルを検索できます。

Dictionaryオブジェクトについて

Dictionaryオブジェクトの良い説明はウェブ上に特にないと思うのですが、Dictionaryオブジェクト - Microsoft MSDNにいくらか説明があります。

あと、Dictionaryオブジェクトを使っていると大量のデータを蓄積することもあると思います。使い終わったらSet object = Nothingを忘れずに書かないとメモリリリースされないので注意が必要です。私はSet object = Nothingを書かないとメモリがリリースされない - KOSUKE MAEDAに書いたように失敗しました。