検索マクロがおかしくなって原因がわかりません

質問

Sheet1のA列にはあらかじめ通し番号が１から入っていて、B列３行目からデータを入力していき、データ入力がされているまでの範囲で検索条件を満たすデータをSheet2へ表示させるマクロ実行で、いつしか、Sheet1のB列にデータが入っていないあらかじめ入力済みのA列の番号全てが検索結果として表示されるようになり、原因がわかりません。
お助けください。

Sub 未到着()
Dim Rng As Range
Dim i As Long
Dim Deliveries As Variant
Dim h As Long, j As Long
Dim DataRows As Long
Dim Result As String

''未到着書類（Sheet2）のフィールド行(受付番号、氏名）は、5行目に（設定して）ある
With Sheet1
'Sheet1 をオープン
.Activate
i = 6 '6行目から該当リストを表示させる

'ユーザーフォームによるメッセージ表示
UserForm1.Show vbModeless
DoEvents

Set Rng = Range("B3", .Range("B65536").End(xlUp))
For Each c In Rng
'　"通知書", "受領書", "預り証", "保険証書"　の４項目を検索
If Application.CountA(c.Offset(, 9).Resize(, 4)) <> 4 Then
'A列から、A列を含めて１4列取得し、未到着書類にコピー
c.Offset(, -1).Resize(, 14).Copy Sheet2.Cells(i, 1)
i = i + 1
End If
Next
End With

'メッセージ用のユーザーフォームを閉じる
UserForm1.Hide
'配列式に格納
Deliveries = Array("通知書", "受領書", "預り証", "保険証書")
'Sheet2 をオープン
With Sheet2
.Activate
DataRows = Range("A2", Range("A65536").End(xlUp)).Rows.Count + 1
For h = 6 To DataRows '6行目から
For j = 11 To 14 '10列目～13列目
If .Cells(h, j).Value = "" Then '調べたセルの文字列0の長さだったら、
'配列より、取り出す
Result = Result & ";" & Deliveries(j - 11)
End If
Next j
If Result <> "" Then
'結果が空でないなら、N列に貼り付け
.Cells(h, 14).Offset(, 1).Value = Mid(Result, 2)
Result = ""
End If
Next h
End With

End Sub

回答No.3

Wendy02

こんにちは。

やっぱり読みきれないですね。たぶん、人が作ったものを変えたものだと思いますが、変なところがいくつもあります。

例えば、
.Cells(h, 14).Offset(, 1).Value = Mid(Result, 2)
なぜ、こうなるのでしょうね。ワンセルに全部入れるということでしょうか？一個ずつセルに入れてくれれば問題はないでしょうけれども。
この部分の貼り付けの結果をちょっと調べてみてくださいませんか？

今のコードでは、前の部分の
If Application.CountA(c.Offset(, 9).Resize(, 4)) <> 4
とは合わないです。
やむをえないけれども、CountIf で、4つの文字を数えるしかないですね。コードとしては見にくくなってしまいますが。それも、Countif(範囲,"*通知書*") >0 というようなスタイルになります。

そうでないなら、その貼り付けを、Split を使って、分けて、セル一個ずつに入れるかです。ただし、セルの余裕があればの話しです。

ret =Split(Mid(Result, 2),";")
.Cells(h, 14).Offset(, 1).Resize(,Ubound(ret)+1).Value =ret

いままで出来ていたなら、何かの都合で書き換えましたね。
どういう理由か、なぜか、いきさつを思い出してみてください。こちらでは、その優先順位が分かりません。

回答No.2

Wendy02

訂正

>CountA とは、セルに何か、数値でも文字列でも入っていれば、1と数えるものです。

数が少なければ、Copy されるなら、CountA をCount に変えても、減るわけだから、そうではなさそうです。だから、私の#1 は、間違いですね。

どうも、その部分は、私が１年前ぐらい書いた部分ですね。
http://oshiete1.goo.ne.jp/qa2487829.html

ただし、やっぱり、 <　4 になっていましたし、Application.CountA ではなくて、WorksheetFunction.CountA でしたけれども。（なぜ、そうするかというと、エラー値が入ったときに、実行時エラーにするからです。Application.CountA ですと、エラー値はエラー値のままです。）

そうすると、どこが違う部分なのでしょうか？こちらで、想像して探すのは、ちょっときついですね。

正直言って、プロシージャの途中で、UserForm1.Show をして、また途中で、UserForm1.Hide っていうのは、ちょっと考えられない内容なんですね。

p.s.2007/5月　以降の質問は、一応、終えたと思うものは締めてしまったほうがよいですよ。

回答No.1

Wendy02

こんにちは。

>Set Rng = Range("B3", .Range("B65536").End(xlUp))
>For Each c In Rng
>'　"通知書", "受領書", "預り証", "保険証書"　の４項目を検索
>If Application.CountA(c.Offset(, 9).Resize(, 4)) <> 4 Then
>'A列から、A列を含めて１4列取得し、未到着書類にコピー
>c.Offset(, -1).Resize(, 14).Copy Sheet2.Cells(i, 1)
>i = i + 1
>End If

Application.CountA(c.Offset(, 9).Resize(, 4))
この部分で、正しく、値が返っているかチェックはしてみましたか？

たぶん、４セルですから、「 <　4」 だとは思いますが、
「"通知書", "受領書", "預り証", "保険証書"　の４項目を検索」を検索するのに、
と　「<> 4」で済むわけはないですね。これでは、何を検索しているのか良く分かりません。
数値なのですか？

CountA とは、セルに何か、数値でも文字列でも入っていれば、1と数えるものです。
その部分を吟味したほうがよいのではありませんか？

一般的には、Count で検索したほうが良いように思います。