ExcelVBA。行を検索してセルに文字が入っていたら、その行を残して他の行を削除したい。

ExcelVBAに関する質問です。（カテ違いで質問したためこちらで再度質問します）
部課ごとに研修管理表.xlsx（共有）を作成しています。

A列：№
B列：研修内容
C列：備考欄
D列～AD列：氏名

９行目～１００行目あたりまで、B列に研修内容が記載されています。
D～AD列に書かれた個人が、研修を受けたいセルに自分で○印をつけます。
（氏名の記載は、D８～AD８にあります。 ※ADを超える場合も想定しています。）

D9～AD１００に○印が入力されている行のみ残し、入力されていない行を削除したく、
色々調べて以下のようなコードをみつけたので修正したうえで記述してみました。
実行結果は、○印のある行を抽出することはできましたが、○印のない行を削除できません。
○印の開始はD9ですが、最終はAD列以降になる可能性もあります。（人が増えたら）
また、研修内容も１００行以降増えないと思いますが、増えてもいいようにしたいです。
VBAに精通しているかた、どうぞよろしくお願いします。



Sub sample()
Dim a As Range
Dim r As Range
Dim c As Range
Dim f As Range

Set a = Range("D9:AD100")
Set c = a.Find(what:="○", lookat:=xlWhole)
If c Is Nothing Then
MsgBox "処理すべきものがありません"
Exit Sub
End If

Set f = c

Do
If r Is Nothing Then
Set r = c.EntireRow
Else
Set r = Union(r, c.EntireRow)
End If
Set c = a.FindNext(c)
Loop While c.Address <> f.Address
MsgBox "以下の行を残して他の行を削除します" _
& vbLf & Join(Split(r.Address, ","), vbLf)
r.Delete
End Sub

No.1 回答者： くんこば 回答日時： 2016/05/17 21:55

for分でいいんじゃないですか？

ちなみに、for分で削除するときは「下から上へ」です。
for分の終了条件を変数か定数にしとけば、とりあえずOK。

どの程度理解できました？

No.2 ベストアンサー 回答者： ママチャリ 回答日時： 2016/05/17 21:57

こんな感じでしょうか。

Sub sample()
Dim I As Long
For I = Cells(Rows.Count, "A").End(xlUp).Row To 9 Step -1
If WorksheetFunction.CountIf(Range(Cells(I, "D"), Cells(I, Columns.Count)), "○") = 0 Then
Rows(I).Delete Shift:=xlUp
End If
Next
End Sub

この回答へのお礼

コードがシンプルで無駄がなくとてもわかりやすいです。
こちらの要望通りの結果を出せました。
ありがとうございました。

お礼日時：2016/05/18 21:03

No.3 回答者： tom04 回答日時： 2016/05/17 22:02

こんばんは！

行すべてを削除しても良いのですね？
一例です。

Sub Sample1()
Dim i As Long, lastCol As Long
Dim c As Range, myRng As Range, myArea As Range
lastCol = Cells(8, Columns.Count).End(xlToLeft).Column '←8行目で最終列取得//
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row '←9行目～A列最終行まで//
Set myRng = Range(Cells(i, "D"), Cells(i, "AD"))
Set c = myRng.Find(what:="○", LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
If myArea Is Nothing Then
Set myArea = myRng
Else
Set myArea = Union(myArea, myRng)
End If
End If
Next i
If Not myArea Is Nothing Then
myArea.EntireRow.Delete shift:=xlUp
End If
End Sub

※　質問文にあるコードは「FindNext」を使っていらっしゃいますが、
上記コードは行ごとに検索し、その行にあるか？ないか？だけの判断にしています。m(_ _)m

No.4 回答者： tom04 回答日時： 2016/05/17 22:08

No.3です。

投稿後気づきました。

コード内の
＞Set myRng = Range(Cells(i, "D"), Cells(i, "AD"))
の行を
＞Set myRng = Range(Cells(i, "D"), Cells(i, lastCol))
に変更してください。

前回のコードではAD列までの範囲になってしまいます。

どうも失礼しました。m(_ _)m