エクセルでのVBA（マクロ）

質問

以前Wendy02さまに
以下のようなデータがシート１に入力されているもので
　　A　　B　　　C　　　　D　　　E　　　　F　
１名前　住所　請求書　納品書　領収書　到着確認書
２山田　東京　　○　　　　　　　○
３井上　千葉　　　　　　○　　　○　　　　○
４植田　大阪　　　　　　○　　　○
５境　　秋田　　○　　　○
６大田　沖縄　　○　　　○　　　○　　　　○
７野原　埼玉　　　　　　　　　　○

データの”○”は書類が確認済で、空白は未確認あるいは未到着です。
"C"列から"F"列の中で１つ以上空白のあるデータを検索して別シート２へそのままコピー出来るマクロを教えていただいたのですが、
Ａ列に受付番号（５００件）を先に入力しておいて（一応自分でマクロを組んで）同じ処理をするとデータ（Ｂ列：名前）が入力されていないものまで検索結果としてカウントされます。

Sub FindBlank1()
Dim Rng As Range
Dim i As Long
'Sheet2のフィールド行(名前,住所..）は、１行目にあるとします。
With Sheet1
.Activate
i = 2 '2行目から
Set Rng = .Range("A1", .Range("A65536").End(xlUp))
For Each c In Rng
　If Application.CountA(c.Offset(, 2).Resize(, 4)) <> 4 Then
　　 'A列から、A列を含めて６列取得し、Sheet2にコピー
　　 c.Resize(, 6).Copy Sheet2.Cells(i, 1).Resize(, 6)
　　 i = i + 1
　End If
Next
End With
End Sub

＞i = 2 '2行目から
の前に組めば出来る筈だと思うのですが？
お助けください。

回答No.1

ham_kamo · ベストアンサー

以下のように修正すればいいのではないでしょうか。

Sub FindBlank1()
Dim Rng As Range
Dim i As Long
'Sheet2のフィールド行(名前,住所..）は、１行目にあるとします。
With Sheet1
.Activate
i = 2 '2行目から
Set Rng = .Range("B1", .Range("B65536").End(xlUp))
For Each c In Rng
　If Application.CountA(c.Offset(, 1).Resize(, 4)) <> 4 Then
　　 'A列から、A列を含めて６列取得し、Sheet2にコピー
　　 c.Offset(,-1).Resize(, 6).Copy Sheet2.Cells(i, 1).Resize(, 6)
　　 i = i + 1
　End If
Next
End With
End Sub

お礼

＞Set Rng = .Range("B1", .Range("B65536").End(xlUp))
やはりＡをＢに変更するだけでしたか？１度変更してやったつもりなのですが？
＞c.Offset(,-1)
これを忘れていたようです。
ありがとうございました。

回答No.3

Wendy02

こんばんは。Wendy02です。

最近は、少し、コードの書き方を変えていますが、私自身としては、#1のham_kamo　さんのコードのように書くようになると思います。

つまり、A列は、先に、データのあるなしに関わらず、受付番号として存在してしまっていますから、事実上、1列増えて、B列の名前で、処理しなくてはならなくなったわけですから、正しいデータを取るためには、以下が必要です。

　.Range("B1", .Range("B65536").End(xlUp))

ただ、もし、受付番号を含め7列にするのだったら、
　c.Offset(,-1).Resize(, 7).Copy Sheet2.Cells(i, 1).Resize(, 7)
このようになるかと思います。実際には、今は試していないので、不安がありますが。

何か、ham_kamoさんと、venzoさんの良いとこ取りで申し訳ないです。

お礼

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

回答No.2

noname#22650

A列を追加してデータが右にずれたと言うことでしょうか？

でしたら、ここの 2 を 3 に変える
誤：If Application.CountA(c.Offset(, 2).Resize(, 4)) <> 4 Then
正：If Application.CountA(c.Offset(, 3).Resize(, 4)) <> 4 Then
これでC列から4列空白かどうか判定することになると思います。

ついでに、ここの6を7に
誤：c.Resize(, 6).Copy Sheet2.Cells(i, 1).Resize(, 6)
正：c.Resize(, 7).Copy Sheet2.Cells(i, 1).Resize(, 7)
これでA列から7列（G列まで）コピーされると思います。

お礼

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