VBAの勉強用に購入した書籍も、やっと折り返しに到達し、徐々に出来ることが多くなってきました。
今回は、検索対象の中から、探したい名前を検索し、一致した場合にセルを黄色にするVBAを書いてみました。
下の画像(A列が検索対象、D列が探したい名前一覧)のように、姓と名前の間にスペースが入っている場合も、対応可能なプログラムにしています。
概要
まずは、氏名の間に入っている各種スペースを削除します。
全角スペース、半角スペース、半角スペースx2が挿入されている場合は、削除します。
その後、二重ループを使用して、A列の各一行に対して、D列の名前を全て一致するかどうかチェックしています。
一致する場合は、A列の該当セルを黄色にします。
今回のコードを実行した様子が、下の画像となります。
実行前
↓
コード【VBAマクロ】
- Sub rows_matching()
- Dim i As Integer '検索対象
- Dim ii As Integer '検索したい名前
- Dim i_lastrows As Integer
- Dim ii_lastrows As Integer
- i_lastrows = Range("A" & Rows.Count).End(xlUp).Row
- ii_lastrows = Range("D" & Rows.Count).End(xlUp).Row
- For i = 2 To i_lastrows
- Range("A" & i) = Replace(Range("A" & i), " ", "")
- Range("A" & i) = Replace(Range("A" & i), " ", "")
- Next i
- For ii = 2 To ii_lastrows
- Range("D" & ii) = Replace(Range("D" & ii), " ", "")
- Range("D" & ii) = Replace(Range("D" & ii), " ", "")
- Next ii
- For i = 2 To i_lastrows
- For ii = 2 To ii_lastrows
- If Range("A" & i).Value = Range("D" & ii).Value Then
- Range("A" & i).Interior.Color = vbYellow
- End If
- Next ii
- Next i
- End Sub
コード【VBAマクロ】の解説
2-3.
行数をi(A列に対して)とii(D列に対して)と定義します。
5-6.
iとiiの最終行を、それぞれi_lastrowsとii_lastrowsと定義しています。
8-9.
A列とD列の最終行を、それぞれ取得しています。
11-14.
マッチング検索の前に、名前に挿入されているスペース(全角、半角、半角x2)を削除します。
For文で、A列の2行~最終行まで処理を行います。
Replace関数で、” “(半角スペース)を””(文字なし)に置き換えることで、半角スペースの削除を行います。
同様に、” ”(全角スペース)に対しても””(文字なし)に置き換えることで、全角スペースの削除を行います。
16-19.
D列に対しても、A列の前処理と同様に、名前に挿入されているスペース(全角、半角、半角x2)を削除します。
21-22.
iとiiに対して、二重ループを行っています。これにより、全ての組み合わせをチェックすることが出来ます。
例えば、i = 2のとき(A2セル)、2行から最終行までのii行全て(D2~D5)の項目で、A2セルとの比較を行うことが出来ます。
23-24.
If文を用いて、A列のi行目と、D列のii行目の値が同じ場合に、検索対象のA列i行目セルを黄色にします。
今回のコードでは、完全一致の場合のみに対応しています。
一致した件数をカウントしたり、部分一致の場合に色を変えるなどしても楽しそうですね。