タイトル名で複数列を取得し、その列を削除するマクロ

質問

1行目にタイトル名があり、タイトル名で複数列を取得し、その列を削除するマクロを作成したいです。
いろいろ調べ、下記のコードを試し、1つの列は削除可能でしたが、
複数となるとどのようになるのか分からず・・どなたかお教えいただければ助かります。
以下は「たんぽぽ」のみですが、1行目に花の名前が多数並んでおり、「たんぽぽ」「バラ」「百合」…を一緒に削除したいです。

Dim R As Range
Do
Set R = ActiveSheet.Range("A:ZZ").Find(What:="たんぽぽ", LookAt:=xlWhole)
If R Is Nothing Then Exit Sub
R.EntireColumn.Delete Shift:=xlToLeft
Loop

回答No.3

kkkkkm · ベストアンサー

No1の訂正の訂正です。

If .Range("A1") = "" Then Exit Sub
より
Do
の後に
If buf(1, i) = "" Then Exit Do
を追加の方が一覧で途中空きがあっても対応できるのでこちらのほうが良さそうです。

お礼

ご丁寧にありがとうございました。
参考にさせていただき、結果を得ることができました！

回答No.2

kkkkkm

No1はA1から花一覧がない場合エラーや長時間反応なしなどになりますので

With ActiveSheet
の後に
If .Range("A1") = "" Then Exit Sub
とでもしておいてください。

回答No.1

kkkkkm

1行目の花名一覧も検索対象でしたら
Sub Test()
Dim R As Range
Dim i As Long, buf As Variant

With ActiveSheet
buf = .Range(.Cells(1, "A"), .Cells(1, Columns.Count).End(xlToLeft))
For i = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
Do
Set R = .Range("A:ZZ").Find(What:=buf(1, i), LookAt:=xlWhole)
If R Is Nothing Then Exit Do
R.EntireColumn.Delete Shift:=xlToLeft
Loop
Next
End With
End Sub

1行目は対象にしないがA列の2行目からZZ列まで対象にする場合

Sub Test2()
Dim R As Range
Dim i As Long, buf As Variant
Dim LastColumn As Long

With ActiveSheet
buf = .Range(.Cells(1, "A"), .Cells(1, Columns.Count).End(xlToLeft))
LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column

For i = 1 To LastColumn
Do
Set R = .Range(.Cells(2, "A"), .Cells(Rows.Count, "ZZ")) _
.Find(What:=buf(1, i), LookAt:=xlWhole)
If R Is Nothing Then Exit Do
R.EntireColumn.Delete Shift:=xlToLeft
Loop
Next
End With
End Sub

1行目の花名一覧の右から(D1まで一覧があればE列から)検索する場合は

.Cells(2, "A")
を
.Cells(2, LastColumn + 1)
にしてください。