【365】指定したセルに記載のある名前だけ残す

質問

指定した名前以外の人が入った行を消去するマクロを設定してありますが、人の入れ替わりが激しいため都度マクロを加工するのが面倒になってきました。

(現在のマクロ)AD列に名前が入力されており、Ａ子／Ｂ太／Ｃ介以外の人の行は消去(削除ではありません)

For i = Cells(Rows.Count, "AD").End(xlUp).Row To 1 Step -1
If Cells(i, "AD") <> "Ａ子" And _
Cells(i, "AD") <> "Ｂ太" And _
Cells(i, "AD") <> "Ｃ介" Then
Rows(i).Clear
End If
Next

今後、対象人数が増える可能性もあるため、別シートの指定セルに入力してある名前以外を消去するマクロへ変更したいです。

(今後)マスタというシートのセルB3:B11に入力されている名前以外の人を消去したい

そのようなマクロは作成可能でしょうか？

回答No.2

kkkkkm · ベストアンサー

回答No.1の追加です。

これもありかもしれません。

Sub Test2()
Dim i As Long
Dim Index As Variant

For i = Cells(Rows.Count, "AD").End(xlUp).Row To 1 Step -1
Index = Application.Match(Cells(i, "AD").Value, Sheets("マスタ").Range("B3:B11"), 0)
If IsError(Index) Then
Rows(i).Clear
End If
Next

End Sub

お礼

再度のご回答ありがとうございました。

こちらのマクロでうまく作動しましたが、別の問題が発生しましたので一部変更をお願いしたいです。

現状は「担当者以外を削除→別ファイルへ値貼り付け」というマクロのためAD自体を指定しても問題ありませんでしたが、本マクロ適用後は「別ファイルへ値貼り付けした後に担当者以外を消去」するため、1行目(ヘッダー)も消えてしまいました。
ヘッダーは残しておきたいので、2行目(AD2)以降を対象にしたマクロへ変更していただくことは可能でしょうか？

回答No.3

kkkkkm

> ヘッダーは残しておきたいので、2行目(AD2)以降を対象にしたマクロへ変更していただくことは可能でしょうか？

For i = Cells(Rows.Count, "AD").End(xlUp).Row To 1 Step -1

この部分が対象となる行の指定部分で、AD列の最終データのある行から「 To 1 」で1行目までという指定になっています。
ですので「 To 1 」の「1」を「2」にしてやると2行目までが対象になり1行目(ヘッダー)は無条件で残るようになります。

For i = Cells(Rows.Count, "AD").End(xlUp).Row To 2 Step -1

お礼

修正版のご回答ありがとうございました。

完璧です!!
大変助かりました!!

このマクロは他のWebサイトからコピペしてきたので、どのような動きをするのか理解していませんでした。

回答No.1

kkkkkm

以下のような方法でいかがでしょう。

Sub Test()
Dim i As Long, j As Long
Dim MatchFlg As Boolean

For i = Cells(Rows.Count, "AD").End(xlUp).Row To 1 Step -1

With Sheets("マスタ")
MatchFlg = False
For j = 3 To .Cells(.Rows.Count, "B").End(xlUp).Row
If Cells(i, "AD").Value = .Cells(j, "B").Value Then
MatchFlg = True
Exit For
End If
Next
End With

If MatchFlg = False Then
Rows(i).Clear
End If

Next

End Sub

お礼

ご回答ありがとうございました。

No.2の方がシンプルですので、そちらを採用させていただきました。