：【Excel VBA】 Do Until ～ Loop 構文で途中の空白セルを飛ばしてデータのチェックをしたい

こんにちは。

Do Until ～　Loop　構文で
空白セルまでループして重複する値をチェックしたいと考えています。

---------------------------------------------
Sub 重複チェック()
Dim 検索語 As String
Dim 該当数 As Long
Dim 確認 As Integer
Range("A4").Activate

Do Until ActiveCell.Value = ""

検索語 = ActiveCell.Value
該当数 = WorksheetFunction.CountIf(Range("A:A"), 検索語)

If 該当数 >= 2 Then

ActiveCell.AutoFilter Field:=1, Criteria1:=検索語

確認 = MsgBox("次を検索しますか？", vbYesNo)
If 確認 = vbNo Then Exit Sub

End If

ActiveCell.Offset(1, 0).Activate

Loop

Range("A4").AutoFilter

MsgBox "名前の重複チェックが終了しました。"

End Sub
---------------------------------------------

ただセルA列には行の途中、空白も含まれているため、
途中で止まってしまいます。

今後A列にはデータが追加されていきます。
途中の空白セルを飛ばして、
データーの最後までチェックするにはどのようにすればよいでしょうか？

No.6 ベストアンサー 回答者： merlionXX 回答日時： 2006/05/24 12:00

> 以降空白４列下のセルで動作が終了するのはどうしてでしょうか？

失礼しました。
開始が4行目のセルだということを失念していました。

Sub 重複チェック()
Dim 検索語 As String
Dim 該当数 As Long
Dim 確認 As Integer
Dim x As Long, n As Long

x = ActiveSheet.Cells(65536, "A").End(xlUp).Row '最終行取得

For n = 4 To x '最終行まで検索
Cells(n, 1).Activate
検索語 = ActiveCell.Value
該当数 = WorksheetFunction.CountIf(Range("A:A"), 検索語)

If 該当数 >= 2 And 検索語 <> "" Then
ActiveCell.AutoFilter Field:=1, Criteria1:=検索語

確認 = MsgBox("次を検索しますか？", vbYesNo)
If 確認 = vbNo Then Exit Sub

End If

Next n
Range("A4").AutoFilter
MsgBox "名前の重複チェックが終了しました。"
End Sub

この回答へのお礼

merlionXXさま

ご丁寧にありがとうございます。
このままコピーで使用できますね（笑）

お忙しいところ
ありがとうございました！！

お礼日時：2006/05/24 12:17

No.5 回答者： merlionXX 回答日時： 2006/05/24 11:43

No2-3です。

> 空白セルもカウントするようです。

では、

If 該当数 >= 2 And 検索語 <> "" Then

としてみてください。

この回答へのお礼

merlionXXさま

今回は本当にありがとうございました。
おかげさまで、理想のマクロを組むことができました。

VBAって一つ一つが勉強ですね。
また勉強になりました。

今後ともお世話になるかもしれませんが、
そのときはよろしくお願いいたします！

お礼日時：2006/05/24 12:08

No.4 回答者： TTak 回答日時： 2006/05/24 11:26

異なる方法ですが、findメソッドを使えば、最終行取得不要、かつ、データ行数が増えても高速検索ができます。

（ループ部分のみの例です）

With ActiveSheet.Range("A:A")
　Do
　　Set c = .Find(検索語, After:=ActiveCell, LookIn:=xlValues)

　　'検索の繰り返しを判定
　　If Range(c.Address).Row <= a Then Exit Sub

　　'検索条件セルの除外
　　If Range(c.Address).Row = 4 Then GoTo AA:
　　　a = Range(c.Address).Row

　　　Range(c.Address).Select
　　　確認 = MsgBox("次を検索しますか？", vbYesNo)
　　　If 確認 = vbNo Then
　　　　Set c = Nothing
　　　　Exit Sub
　　　End If
AA:
　　Loop Until c Is Nothing
End With

この回答へのお礼

TTakさま

ご回答ありがとうございます。
空白セルもカウントされてしまいました・・・
この構文は今後の勉強とさせていただきます。

ありがとうございました!

お礼日時：2006/05/24 12:11

No.3 回答者： merlionXX 回答日時： 2006/05/24 10:48

No2です。

データがA列ときまっているのでしたら
With ActiveSheet.UsedRange
x = .Cells(.Count).Row '最終行取得
End With
なんてまだるっこいことをしなくても

x = ActiveSheet.Cells(65536, "A").End(xlUp).Row
で最終行取得できましたね。

こっちでやってみてください。

この回答へのお礼

ご回答ありがとうございます！

スムーズに動作するようになりましたが、
空白セルもカウントするようです。
データが入っているセルの
以降空白４列下のセルで動作が終了するのは
どうしてでしょうか？

お礼日時：2006/05/24 11:26

No.2 回答者： merlionXX 回答日時： 2006/05/24 10:36

With ActiveSheet.UsedRange

x = .Cells(.Count).Row '最終行取得
End With

Do Until ActiveCell.Value = ""　を　For n = 1 to x'最終行まで検索

Loop　を　Next n

に書き換えると、空白があろうがなかろうが、データの最終行まで検索します。

No.1 回答者： kamejiro 回答日時： 2006/05/24 10:13

Do Until ActiveCell.Value = ""　を　For I = 1 to 65536

Loop　を　Next I

に書き換えると、空白があろうがなかろうが、ワークシートの全行を見ることになり、重複する値をチェックできるかと思います。（試していません）
ただ、実行させてから終了まで、すごい時間が掛かると思います。
（試す前に一度データをバックアップとって下さい）

それか、

Do Until ActiveCell.Value = ""　を　Do Until ActiveCell.Value = "END"

にして、明らかにこの行から下にはデータがないＡ列のセルに「END」を入れておく方法くらいしか思いつきません。

この回答へのお礼

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

これですとデータの最後以降も
空白セルをチェックをし「次を検索しますか？」のメッセージが
何度も出てきてしまいます。

お礼日時：2006/05/24 10:43