エクセルでのVBA（マクロ）が出来ますか？

質問

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

データの”○”は書類が確認済で、空白は未確認あるいは未到着です。
"C"列から"F"列の中で１つ以上空白のあるデータを検索して別シート２へそのままコピー出来るマクロ、そしてシート２に表示されたデータで空白となっている"C"列から"F"列の項目名（請求書等）をシート３に用意してあるあいさつ文の書類名入力セル（ここではE１０としておきます）に記入できるマクロがさっぱり分かりません。
データ件数は１０００件以上になるかと思います。
どなたかお助けください。

回答No.4

Wendy02 · ベストアンサー

ja7awuさん、Thanks

hirosatonn さん、
c.Resize(, 6).Copy
として、6列を取得していますから、「A列のみしかコピー」されない、というのは、コードを見る限りでは、初歩的なコードですから、そのようなことは考えられません。何か、私の書いたコードを変更されたか、A列の右隣－B列移行が、隠し列になっているか、などだと思います。
ただし、念のために、加筆してみました。

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

Sub FildBlank2()
Dim Deliveries As Variant
Dim i As Long, j As Long
Dim DataRows As Long
Dim Result As String
'配列式に格納
Deliveries = Array("請求書", "納品書", "領収書", "到着確認書")
With Sheet2
'Sheet2 をオープン
.Activate
DataRows = Range("A2", Range("A65536").End(xlUp)).Rows.Count + 1
For i = 2 To DataRows '2行目から
　For j = 3 To 6 '3列目～6列目
　If .Cells(i, j).Value = "" Then '調べたセルの文字列0の長さだったら、
　　 '配列より、取り出す
　　 Result = Result & ";" & Deliveries(j - 3)
　End If
　Next j
　If Result <> "" Then
　　　'結果が空でないなら、H列に貼り付け
　　 .Cells(i, 7).Offset(, 1).Value = Mid(Result, 2)
　　 Result = ""
　End If
Next i
End With
End Sub

Sheet3 の"E10" に出すのは、関数などで行ってください。
つまり、"E10" に、全て出すということはありえませんから、INDEX 関数などを使って、Sheet2 から、引き出すのが良いと思います。

=INDEX(Sheet2!A2:H17,H1,8)

H1 に、数字を入れます。

現実の問題として、1000件以上ですから、この後に、印刷という作業が加わるものだと思います。しかし、[教えて!goo]では、書き込みの際の物理的な制約もありますので、専門のExcel のVBAの掲示板なりでお尋ねになるか、goomaniaさんの#2 の内容を参考にしてください。ここら辺が限界です。

お礼

色々とありがとうございました。そしてすみませんでした。コードをちょっといじっていました。
関数を使って頑張ってみます。

回答No.3

ja7awu

> そしてA列のみしかコピーされません。

コードをそのままコピーして使いましたか？

括弧の中の　, が落ちている可能性がありますよ。

後半の件は、山田さんの場合は、それでいいとしても、次の井上さんとかは、
どうするのですか？

1つでも○が無い人について挨拶文を差込印刷したい　といことと違うのですか?

もうちょっと、解るように書きましょう。

横レス　失礼 !!

回答No.2

goomania

質問者さんのVBAについてのご理解の程度がわかりませんが、ご自分でVBAプログラムをある程度作成できる実力がないと、この「教えてgoo」サイトで質問者さんのご希望をかなえるVBAプログラムを公開して欲しいというご要望になってしまいます。
ご質問の内容から推察すると、請求書・納品書・領収書の未発行先について、挨拶文とともに発送する事務を合理化するためのプログラムだと思いますが、これをそのまま公開することはプログラムも大きいと考えられますので基本的に無理があります。
最終的な目的が「EXCELのVBAマクロを使って請求書、納品書、領収書の発行を管理する」ことだとすると、以下のサイト
http://www.vector.co.jp/soft/win95/business/se251819.html?site=n
などからEXCELのVBAマクロを使ったプログラムをダウンロードして研究してみるのはどうでしょう。
ご自分である程度作成できるようになったら、プログラムがご自分の望んでいる動作にならない場合などについてお尋ねいただいたほうがより具体的なアドバイスが返ってくるように思います。
参考ＵＲＬにもその他のEXCELマクロを使用した販売管理ソフトなどがありますのでご覧下さい。

参考URL：

http://www.nifty.com/download/win/business/hanbai/index.htm

回答No.1

Wendy02

＞"C"列から"F"列の中で１つ以上空白のあるデータを検索して
＞別シート２へそのままコピー出来るマクロ、

Sub FindBlank()
Dim Rng As Range
Dim i As Long
'Sheet2のフィールド行(名前,住所..）は、１行目にあるとします。
i = 2
Set Rng = Range("A1", Range("A65536").End(xlUp))
For Each c In Rng
　If Application.CountA(c.Offset(, 2).Resize(, 4)) <> 4 Then
　　 'シート2にコピー
　　 c.Resize(, 6).Copy Sheet2.Cells(i, 1)
　　 i = i + 1
　End If
Next
End Sub

こちらは意味が分かりません。
＞シート２に表示されたデータで空白となっている"C"列から"F"列の項目名（請求書等）をシート３に用意してあるあいさつ文の書類名入力セル（ここではE１０としておきます）に記入

お礼

ありがとうございます。
コードを実行させたところ、空白の無いデータもシート２へコピーするのですが...そしてA列のみしかコピーされません。シート２へのコピーは行全部のデータをしたいのですが。..

補足

すみません。表現方法が悪くて・・・
たとえば
　　A　　B　　　C　　　　D　　　E　　　　F　
１名前　住所　請求書　納品書　領収書　到着確認書
２山田　東京　　○　　　　　　　○
上の例ですと
"A2"の山田さんですと"D1:納品書"と"F1:到着確認書"が未確認（未到着）ですので、シート３（あいさつ文）のセル"E10"に"納品書；到着確認書"という文言（空白の部分が１つであれば、その書類名）を入れることなのですが・・