プロが教えるわが家の防犯対策術!

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

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

A 回答 (4件)

>"C"列から"F"列の中で1つ以上空白のあるデータを検索して


>別シート2へそのままコピー出来るマクロ、

Sub FindBlank()
Dim Rng As Range
Dim i As Long
'Sheet2のフィールド行(名前,住所..)は、1行目にあるとします。
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

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

この回答への補足

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

補足日時:2005/04/17 20:42
    • good
    • 0
この回答へのお礼

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

お礼日時:2005/04/17 21:25

質問者さんのVBAについてのご理解の程度がわかりませんが、ご自分でVBAプログラムをある程度作成できる実力がないと、この「教えてgoo」サイトで質問者さんのご希望をかなえるVBAプログラムを公開して欲しいというご要望になってしまいます。


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

参考URL:http://www.nifty.com/download/win/business/hanba …
    • good
    • 0

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



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

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


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

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

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

横レス 失礼 !!
    • good
    • 0

ja7awuさん、Thanks



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

Sub FindBlank1()
Dim Rng As Range
Dim i As Long
'Sheet2のフィールド行(名前,住所..)は、1行目にあるとします。
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列を含めて6列取得し、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 の内容を参考にしてください。ここら辺が限界です。
    • good
    • 0
この回答へのお礼

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

お礼日時:2005/04/19 21:21

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!