VBA-14複数のセルに書かれた検索値に対してVLOOKUP関数を使う

2021年6月28日2025年4月18日

このサイトはアフィリエイト広告（Amazonアソシエイト含む）を掲載しています

複数のセルに書かれた検索値に対する処理を学習する

今回で「初心者向けエクセルマクロ学習シリーズ」は完結となります。

マクロとは？VBAとは？から始まり色々な事を勉強してきましたね。

VBE、オブジェクトとプロパティの関係、メソッド、変数、IF文、ループ、関数等々。

これが最後です。今まで勉強してきたことを使って課題に取り組んでいただきます。

課題は今まで勉強した範囲より少し広めの内容なので出来なくて当然の仕様にしています。

自力で勉強してコードを完成させてほしいという思いを込めて少し難しいです。

EnjoyExcel

今まで勉強した内容を組み合わせる事で大半の作業には対応できます。
記事を見返したり別のツールで調べてマクロを構築してみてください。

前回の記事

前回は関数の定義とVLOOKUP関数を使ってワークシート関数を勉強しました。

その中でVLOOKUP関数で#N/Aが出た際（エラーの時）マクロが止まらない様対策しました。

前回記事：関数は2種類あります

VBA-13マクロで関数｜VLOOKUPはエラー対策してから使う

本記事での課題

今回の課題です。最後はちょっと難しいかもしれませんが頑張ってみてください。

EnjoyExcel

課題：
課題をクリアして学習をコンプリートしよう

初心者向けエクセルマクロ学習シリーズ

シリーズ最後の課題に挑戦

課題としては今まで勉強してきたことで9割は対応可能ですがちょっと背伸びしてるところもあります。

教えてないところもありますがやってみましょう。取り組んでいただく内容は以下内容となります。

課題の内容

抽出シートにある名前とデータベースの名前が一致したら関連のデータを取り出します。

抽出シートのＥ、Ｆ列の都道府県とカレーの食べ方を取り出すデータを用意してみてください。

ご検討ください

私は「都道府県」と「カレーの食べ方」ですが各自好きなデータを用意してください
抽出シートの実行ボタンで作業を行う様コードを作りこんでみてください
抽出シートの削除ボタンは抽出シートのＥ、Ｆ列を削除する際に使用します

プロシージャとしては２つですね。実行と削除を分けて作ってください。

データ環境：データシート

データシートは2枚になります。プロジェクトエクスプローラは以下のようになっています。

データ環境：各シートのデータ

こちらは　Sheet1（データベース）　という名前のシートです。

これも「なんちゃって個人情報」で作成しているダミーデータです。

各自コードを書くときは名前列とは別に2つ程度の列の情報を使って適当に表を作成してみてください。

件数（行方向）は10件もあれば良いと思います。

続いて　Sheet2（抽出シート）　です。E,F列の空欄を埋める為にコードを用意します。

私が用意したデータベースは5,000件です。抽出シートのＤ列は200件です。

同じ量のデータは必要無いです。できる範囲でデータを用意してください。

あくまでコードが用意できるかどうかが重要です。ほどほどの量のデータを用意してください。

回答

まずは結論です。答えを載せておきます。

変数に日本語使うのは抵抗あるという人も居ますが私は問題無いと思います。誤作動もしませんので。

私は変数を英語でも書きますが日本語の方が引継ぎが楽な印象があります。

何やってるか伝わりやすい事が多いのでメリットもありますよ。実行ボタンのコードです。

1行に収まらないコードが2行にまたがっているところがあります。

コードはそのままコピーしてVBEに貼り付けてください。

ボタンを押すとコードをすべてコピーする事が出来ます。

その後はVBEを選択し「Ctrl+V」で貼り付けましょう。

Sub vlookup()

'変数の定義
Dim 行 As Long
Dim 列 As Long
Dim 抽出行 As Long

'画面更新の停止
Application.ScreenUpdating = False

'データベースの最終行と最終列を確認する
With Sheet1
    行 = .Cells(Rows.Count, 1).End(xlUp).Row
    列 = .Cells(5, Columns.Count).End(xlToLeft).Column
End With

'抽出シートの４列目をループする
For 抽出行 = 6 To Cells(Rows.Count, 4).End(xlUp).Row

    '抽出シートの名前がデータベースに居るのか確認。
    If WorksheetFunction.CountIf _
        (Sheet1.Range(Sheet1.Cells(6, 1), Sheet1.Cells(行, 1)), Sheet2.Cells(抽出行, 4)) > 0 Then
        
        '居たらVLOOKUPで結果を抽出
        Cells(抽出行, 5) = WorksheetFunction.vlookup _
        (Sheet2.Cells(抽出行, 4), Sheet1.Range(Sheet1.Cells(6, 1), Sheet1.Cells(行, 列)), _
        8, False)
        
        Cells(抽出行, 6) = WorksheetFunction.vlookup _
        (Sheet2.Cells(抽出行, 4), Sheet1.Range(Sheet1.Cells(6, 1), Sheet1.Cells(行, 列)), _
        10, False)
    
    Else
        '居ない時は「該当なし」と表示させる
        Cells(抽出行, 5) = "該当なし"
        Cells(抽出行, 6) = "該当なし"
    
    End If

Next

'画面更新停止の解除
Application.ScreenUpdating = True

End Sub

削除ボタンのコードです。ボタンを押下する事でコードをコピーできます。

Sub clear()

'変数の定義
Dim 行 As Long
Dim 行2 As Long

'抽出シートの都道府県とカレーの食べ方が入力されている列の最終行を認識
行 = Cells(Rows.Count, 5).End(xlUp).Row
行2 = Cells(Rows.Count, 6).End(xlUp).Row

'抽出シートの都道府県とカレーの食べ方が入力されている列の最終行が５より大きかったら・・・
If 行 > 5 And 行2 > 5 Then
    '結果をクリアにする（都道府県とカレー食べ方の抽出結果を消去する）
    Range(Cells(6, 5), Cells(行, 6)).ClearContents
End If

End Sub