【Excel VBA】テーブル内の各項目データ検索ツール(コピペですぐ使える)
Excelのテーブル(表)内の各項目の値をそれぞれ指定して検索したいと思ったことはないでしょうか。
その際には、エクセルで管理したデータを検索するときにエクセル機能の「検索」を何度も実行して、対象のデータがある行を確認しては、再度検索、検索、検索…というように非常に手間がかかる作業をしている方も多くいらっしゃるのではないでしょうか。
そんな時に、一度の実行で対象のデータがある行が検索できるツール『テーブル内の各項目データ検索ツール』をExcelマクロで作成しました。
これを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。
記事の目次
『テーブル内の各項目データ検索ツール』の概要
エクセルの表を作成し、その中に日々業務で使用したデータを入れ込んでいきます。
そのデータが蓄積された際に、各項目を対象とした検索ワードを入れて、検索を実行すれば対象セルのみが赤く表示され、検索対象が一度で容易に確認できるようになります。
下に説明動画を載せますので、ご確認ください。
動画を見ると分かりやすいと思います。
<説明動画>
現在準備中…
当ツールの使用方法
基本的な機能、操作方法の説明
1.実行するマクロが入ったExcelファイル(当ツールのマクロ付き)を開きます。
2.対象の表内に検索したいデータを入れた状態にします。(この表から検索をします)
3.各項目を対象にした検索ワードを6行目のセルに文字を入力して、「検索」ボタンを押します。(※検索ワードの対象行である6行目は変更可能)
入力した検索ワードに一致する値があるセルが赤色で表示され、対象の行のみ表示されます。
(補足)
オプションとして、検索する際の条件を指定でき、検索結果の違いは以下になります。
検索する際の条件は、それぞれ以下になります。
<セル内の検索条件>
- 部分一致:それぞれの項目に入力した値の一部が一致する行を表示させる
- 完全一致:それぞれの項目に入力した値が全て一致する行を表示させる
<各項目の検索>
- AND条件:各項目の検索ワードが全て当てはまる行を表示する
- OR条件:各項目の検索ワードが一つでも当てはまる行を表示する
(※複数の項目に値が入力された場合にAND条件またはOR条件で表示されます)
また、表の列数などを変更する場合は、必要に応じてカスタマイズして頂ければと思います。(VBAコード内の「設定値」を一部変更すれば簡易的なカスタマイズが可能です)
留意事項
検索ワードの指定
検索ワード内に空白やワイルドカードの対応していませんので、その場合は、オプションにある「各項目の検索」を『部分一致』にして検索してください。
表の項目の列数を変更する場合
現行のツールでは表の列が「J列」までで作成されていますが、項目数を増減する場合は、以下の対応をしてください。
項目を減らす場合
項目を増やす場合
使用する際の事前準備
このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。
以下にその手順を説明していきます。
準備の手順
1.「サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードします。
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、設定画面(設定シート)が入っているマクロ無しExcelファイルを公開しています
2.ダウンロードしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE(visual basic for application)を起動させます。
3.「プロジェクト」に「標準モジュール」を追加して、追加された「Module1」にVBAコードを記載します。
以下のVBAコードを「module1」内のエディタにコピーして貼り付けます。
※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます
Option Explicit
'---------(設定値)---------------------------
Private Const KEYWORD_ROW = 6 '1.検索ワードを入力する行番号
Private Const HEAD_ROW = 9 '2.テーブル見出し行の行番号
Private Const HEAD_COL_NUM = 1 '3.テーブル見出し行の列番号
Private Const WORK_COL_NUM = 11 '4.作業列の列番号
Private Const SEARCH_TYPE_POINT = "J4" '5.検索条件を指定するセル(AND検索、OR検索)
Private Const SEARCH_TYPE2_POINT = "H4" '6.検索条件を指定するセル(完全一致、部分一致)
'---------(メッセージ)-----------------------
Private Const Msg2 = "検索対象が見つかりませんでした。"
'----------------------------------------------
Dim SearchType1 As String
Dim SearchType2 As String
Dim HeadCellPoint As String
Dim DataCellPoint As String
Dim WorkCol As String
'===============================================
'項目をまたいで検索ボタンを押した時に実行される検索メイン処理
'===============================================
Sub 検索_Click()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim sht As Worksheet
Set sht = ActiveSheet
Dim lastRow, lastColumn, iRow, iCol
Dim keyword As Variant
Dim tgtWord(1) As String
Dim searchResult() As String
Dim searchResult2 As Integer
Dim blnSearchExist As Boolean: blnSearchExist = False
Dim keywordCnt As Long
Dim findCnt As Long
WorkCol = Split(Cells(1, WORK_COL_NUM).Address, "$")(1)
HeadCellPoint = Split(Cells(1, HEAD_COL_NUM).Address, "$")(1) & HEAD_ROW
DataCellPoint = Split(Cells(1, HEAD_COL_NUM).Address, "$")(1) & HEAD_ROW + 1
'検索条件を取得する
SearchType1 = Worksheets(sht.Name).Range(SEARCH_TYPE_POINT).Value
SearchType2 = Worksheets(sht.Name).Range(SEARCH_TYPE2_POINT).Value
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
Range(HeadCellPoint).AutoFilter
End If
Call ClearSheetColor
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = Cells(HEAD_ROW, HEAD_COL_NUM).End(xlToRight).Column
'検索対象の行がある分だけ繰り返す
For iRow = HEAD_ROW + 1 To lastRow
keywordCnt = 0
findCnt = 0
'検索対象の列がある分だけ繰り返す
For iCol = 1 To lastColumn
keyword = Worksheets(sht.Name).Cells(KEYWORD_ROW, iCol).Value
If keyword <> "" Then
keywordCnt = keywordCnt + 1
tgtWord(1) = Cells(iRow, iCol).Value
'完全一致で検索する場合
If InStr(SearchType2, "完全") <> 0 Then
searchResult2 = StrComp(tgtWord(1), keyword)
If searchResult2 = 0 Then
Cells(iRow, iCol).Font.Color = RGB(255, 0, 0)
findCnt = findCnt + 1
End If
'部分一致で検索する場合
Else
searchResult = Filter(tgtWord, keyword)
If UBound(searchResult) <> -1 Then
Cells(iRow, iCol).Font.Color = RGB(255, 0, 0)
findCnt = findCnt + 1
End If
End If
End If
Next
'AND条件で検索する場合
If InStr(SearchType1, "AND") <> 0 Then
If keywordCnt = findCnt Then
Range(WorkCol & iRow).Value = "1"
blnSearchExist = True
End If
'OR条件で検索する場合
Else
If findCnt > 0 Then
Range(WorkCol & iRow).Value = "1"
blnSearchExist = True
End If
End If
Next
'検索対象が存在する場合はフィルターし、存在しない場合はメッセージを表示させる
If blnSearchExist Then
sht.Range(HeadCellPoint & ":" & WorkCol & Format(HEAD_ROW)).AutoFilter Field:=WORK_COL_NUM, Criteria1:="<>"
Else
Call ClearSheetColor
MsgBox Msg2
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
'===================================================================
'フィルター解除ボタンを押した時に実行されるフィルター解除メイン処理
'===================================================================
Sub フィルター解除_Click()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
HeadCellPoint = Split(Cells(1, HEAD_COL_NUM).Address, "$")(1) & HEAD_ROW
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
Range(HeadCellPoint).AutoFilter
End If
Call ClearSheetColor
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
'-------------------------------------
'色の変更、作業行の初期化等を行う
'-------------------------------------
Sub ClearSheetColor()
Dim sht As Worksheet
Set sht = ActiveSheet
Dim iRow
Dim iCol
iRow = Cells(Rows.Count, 1).End(xlUp).Row
iCol = Cells(HEAD_ROW, HEAD_COL_NUM).End(xlToRight).Column
sht.Range(Range(DataCellPoint), Cells(iRow, iCol)).Font.ColorIndex = 1
sht.Range(WorkCol & HEAD_ROW + 1 & ":" & WorkCol & iRow).Clear
End Sub
4.Excelファイル内にある「検索」ボタンと「フィルター解除」ボタンに対して、右クリック→「マクロの登録」を押します。
「検索」ボタンには「検索_Click」を指定して、「OK」を押します。
「フィルター解除」ボタンには「フィルター解除_Click」を指定して、「OK」を押します。
※各ボタンに対して正常にマクロが登録できた場合は、マウスをボタンの上に持っていくと「指のマーク」に変化します
5.作成したExcelファイルを「.xlsm」形式(マクロが動作するファイル形式)で保存します。
これで事前準備は完了です。
あとは「当ツールの使用方法」で記載された方法でツールを実行できます。
また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。
なお、当マクロの開発環境として、OSは “Windows10” 、Excelのバージョンは “Microsoft Office 365″ で行っており、当環境では動作確認ができていますが、他のすべての環境で正常に動作するかは確認できていません。
正常に動作しない場合は、コメントいただければ幸いです。
サンプルのダウンロードはこちら
上記よりダウンロードして、VBAコードを組み込んでマクロを使用してください。
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、設定画面(設定シート)が入っているマクロ無しExcelファイルを公開しています
他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います。