Excel VBA 蓄積データ検索マクロ(コピペで使える便利機能)

 

日常業務を行うにあたって、過去の蓄積されたデータをエクセル表で管理し、必要に応じて都度検索することがあると思います。

 

その際には、エクセルで管理したデータを検索するときにエクセル機能の「検索」を利用していましたが、検索の使い勝手が悪いと思ったので、使い勝手の良い検索マクロを作成しましたので、ご活用頂けたらと思います。

 

ちなみにわたしは、過去の質疑回答集を蓄積データとしてエクセルで管理し、当マクロを利用して検索をスムーズに行えるようにしました。

 

蓄積データ検索マクロの概要

エクセルの表を作成し、その中に日々業務で使用したデータを入れ込んでいきます。

そのデータがある程度の数分だけ蓄積された際に、検索ワードを入れて検索処理を行えば対象行のみが赤く表示され、検索が容易にできるようになります。

 

何ができるマクロか?

1.蓄積データ検索マクロのVBAコードを含んだExcelファイル(***.xlms)を開きます。

 

2.対象表内に日々の業務等で発生し蓄積されたデータを入れ込んだ状態を作ります。

 

3.検索ワード位置(D2)に検索したい文字を入力して「検索」ボタンを押す。

 

4.検索ワードの内容での部分一致で検索結果が表示されました。 

 

補足1

検索ワードにスペースを入れて区切った場合は、「and条件」で検索されます。

例)「A B」で検索ワードを入れた場合は、”A” という文字が入っていて、かつ “B” という文字も入っているセルを検索する。

 

検索結果として、両方を満たす値が入っているセルが検索され、表示されます。

 

補足2

上記では、表内のタイトル行の色が濃紺になっている箇所(D , E , F , J 列)が検索対象として設定されていますが、VBAコード内の値を変えれば、検索対象列を自由に変更することができます。

 

フォルダ自動作成マクロの使用方法

1.Excelを開き、「開発」タブをクリックして、「Visial Basic」をクリックします。

 

2.「Microsoft Excel Object」にて右クリックして「標準モジュール」を挿入します。

 

3.右側の空欄スペースに下記のVBAコードをコピペで入力します。

Option Explicit

Private Const KeywordPoint = "D2"
Private Const StartRow = 5
Private Const WorkCol = "K"
Private Const TableCell = "A4"
Private Const TableCellNohead = "A5"
Private Const WorkColRow = "K5:K"

Private Const SearchTgtCol = "D,E,F,J"        '検索対象の列をカンマ区切りで指定する

'===============================================
'検索ボタンを押した時に実行される検索メイン処理
'===============================================
Sub 検索_Click()

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    If Range(KeywordPoint).Value = "" Then
    
        MsgBox "検索ワードを入力してください。"
        Exit Sub
    
    Else
        Call ClearSheetColor
        
        Dim sht As Worksheet
        Set sht = ActiveSheet
        
        Dim lastRow, iRow, iCol
        
        Dim keyword As Variant
        Dim keywordArr As Variant
        Dim tgtCol() As String
        Dim tgtWord(1) As String
        Dim searchResult() As String
        
        Dim blnExist As Boolean: blnExist = True

        '「D2」における検索ワードを取得する
        keyword = Worksheets(sht.Name).Range(KeywordPoint).Value
        
        '検索ワードの間にスペースがあった場合は文字を分割して格納する
        keyword = Replace(keyword, " ", " ")
        keywordArr = Split(keyword)
        
        '検索対象の列を格納する
        tgtCol = Split(SearchTgtCol, ",")
        
        lastRow = sht.UsedRange.Rows.Count + sht.UsedRange.Row - 1
        
        '検索対象の行がある分だけ繰り返す
        For iRow = StartRow To lastRow
        
            '検索対象の列がある分だけ繰り返す
            For iCol = 0 To UBound(tgtCol)
                
                tgtWord(1) = Range(tgtCol(iCol) & iRow).Value
                
                For Each keyword In keywordArr
                    
                    searchResult = Filter(tgtWord, keyword)
                    
                    If UBound(searchResult) = -1 Then
                        blnExist = False
                        Exit For
                        
                    End If
                    
                Next keyword
                
                If blnExist Then
                    Range(WorkCol & iRow).Value = "1"
                    Range(tgtCol(iCol) & iRow).Font.Color = RGB(255, 0, 0)
                End If
                
                blnExist = True
            
                Erase tgtWord, searchResult
            
            Next iCol
            
        Next iRow
        
        sht.Range("A4:K4").AutoFilter Field:=11, Criteria1:="<>"
        
    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
    
    Call ClearSheetColor
    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
    
        Range(TableCell).AutoFilter
'        ActiveSheet.ShowAllData
    End If
    
    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 = sht.UsedRange.Rows.Count + sht.UsedRange.Row - 1
    iCol = sht.UsedRange.Columns.Count + sht.UsedRange.Column - 1
    
    sht.Range(Range(TableCellNohead), Cells(iRow, iCol)).Font.ColorIndex = 1
    
    sht.Range(WorkColRow & iRow).Clear
    
End Sub

 

4.ファイルを保存する際は「Excelマクロ有効ブック」を選択して、保存します。

 

5.実データを蓄積するシートには、下記ルールを守って画像のように表とセルを配置します。

※VBAコードを一部変更することによりルールの変更をすることができます。

 

6.上部メニューの「挿入」タブ→「図形」→「四角形」を選択して、シート内に二つ図形を作成します。

※図形のデザインはお好みで設定します。

 

7.「検索ボタン」と「オートフィルター解除ボタン」のそれぞれにマクロを設定します。

検索ボタン

オートフィルター解除ボタン

8.検索ワードに値を入れて、検索ボタンをクリックします。

 

9.一度検索をした後に、フィルターを解除する場合はオートフィルタ―解除ボタンをクリックします。

検索条件が解除されて、全データが表示されます。

 

 

また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。

 

サンプルのダウンロードはこちら

 蓄積データ検索マクロのツール本体

 

上記よりダウンロードして、VBAコードを組み込んでマクロを使用してください。
※マクロをインターネットからダウンロードするのはリスクを伴うと思いますので、マクロ入りでなくエクセル形式でアップロードしています。

 

Follow me!

Excel VBA 蓄積データ検索マクロ(コピペで使える便利機能)” に対して4件のコメントがあります。

  1. より:

    作業列をKではない列に変更することは可能でしょうか。
    AQまでの列を使用したいと考えております。

    1. RH より:

      管理人のRHです。
      ご返答が遅れまして、申し訳ありません。
      yさん、ツールのご使用とコメントありがとうございます。

      「AQ列」まで使用するとのことですので、作業列をその次の列である「AR列」にすると考えて、以下を修正頂ければと思います。

      ・5行目を「Private Const WorkCol = “AR”」に変更
      ・8行目を「Private Const WorkColRow = “AR5:AR”」に変更
      ・89行目を「sht.Range(“A4:AR4″).AutoFilter Field:=44, Criteria1:=”<>“」に変更

      上記で目的が実現できない場合は、再度ご連絡をお願いします。

      1. より:

        ご返信いただきありがとうございます。
        3点の修正をしたところ、問題なくマクロが実行できました。
        とても有益な情報をありがとうございました。
        仕事で活用させていただきます。

        1. RH より:

          管理人のRHです。

          問題なくマクロが実行でき、目的が達成されたようで良かったです。
          また何かありましたらコメント願います。

へ返信する コメントをキャンセル

CAPTCHA