Excel：複数のブックを一つにまとめる方法

質問

多数の人に下記のようなファイルを配り、記入して返信してもらいました。

・オリジナルファイル

　　　　　質問1　　質問2　　質問3
Aさん　　N　　　　　N　　　　　N
Bさん　　N　　　　　N　　　　　N
Cさん　　N　　　　　N　　　　　N
Dさん　　N　　　　　N　　　　　N
Eさん　　N　　　　　N　　　　　N

まずファイルを開けたら自分の名前をフィルターし、答えがYesの場合のみNをYに変えて返信してもらいました。回答はYかNしか選べません。フィルターはしてもらっていますが、他の人の行がすべてN状態で残ったまま返信されることになります。

この状態で複数に別れたファイルを一つにしたいと考えています。しかも回答が全列Nの人はスキップしたいです。

・実際の回答をまとめた場合

　　　　　質問1　　質問2　　質問3
Aさん　　Y　　　　　Y　　　　　N
Bさん　　N　　　　　N　　　　　N
Cさん　　Y　　　　　N　　　　　N
Dさん　　Y　　　　　Y　　　　　Y
Eさん　　N　　　　　N　　　　　N

・今回作りたいファイル

　　　　　質問1　　質問2　　質問3
Aさん　　Y　　　　　Y　　　　　N
Cさん　　Y　　　　　N　　　　　N
Dさん　　Y　　　　　Y　　　　　Y

この場合どのようにすれば良いでしょうか。ファイルが400以上あり困っています。
ご存知の方、ぜひご教授ください。宜しくお願い致します。

回答No.3

keithin · ベストアンサー

マクロを使って淡々と調べて集めます。

準備：
Ａ列に名前、Ｂ，Ｃ，Ｄ列（２列目から４列目）に質問とする
１行目にタイトル行、２行目からデータとする
400冊の回答ブックは一か所にまとめて保存しておく
言わずもがなですが回答ブックは、１枚のシートのみ含んでいて、記入してあるものとする

手順：
白紙のブックを一つ用意する
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける
必要な個所を修正する
ファイルメニューから終了してエクセルに戻る
ＡＬＴ＋Ｆ８を押し、マクロを実行する

sub macro1()
　dim myPath as string
　dim myFile as string
　dim i as long

　mypath = "c:\test\"　’４００冊のブックの保存場所を正確に記述すること

　myfile = dir(mypath & "*.xls*")
　do until myfile = ""
　　workbooks.open filename:=mypath & myfile
　　for i = 2 to 4　　　’実際の質問列に合わせて修正すること
　　　range("A:D").autofilter field:=i, criteria1:="N"
　　next i
　　activesheet.autofilter.range.delete shift:=xlshiftup
　　if range("A1") <> "" then
　　　activesheet.range("A1").currentregion.copy destination:=thisworkbook.worksheets(1).range("A65536").end(xlup).offset(1)
　　end if
　　activeworkbook.close false
　　myfile = dir()
　loop
end sub

＃言わずもがなですがマクロブックを４００冊と同じ場所に保存「しない」こと

補足

早速のご回答ありがとうございます。
教えて頂いた通りにやってみたのですが、上手くいきません。

mypath = "c:\test\"
for i = 2 to 4
range("A:D")

の三箇所を適切に変更したつもりなのですが（（3 to 73)と("A:BU")に）、マクロを実行しても何も始まりません。マクロのセキュリティレベルはすべてのマクロ有効になっています。

マクロに不慣れなので恐らく初歩的な問題なのだと思いますが、教えて頂けますでしょうか。
お手数おかけしてすみません。

回答No.4

INTLINSIDE

修正のみで申し訳ないけど。
（私にポイントの類は付けないようにお願いします。私が書いたわけではないので）

試しに

workbooks.open filename:=mypath & myfile
を
set book=workbooks.open filename:=mypath & myfile
に変更。

activeworkbook.close false
を
book.close false
に変更。

したらどうなるでしょうか。

>の三箇所を適切に変更したつもりなのですが（（3 to 73)と("A:BU")に）、マ

は

（3 to 73)と("B:U")

なのではないかと。

たぶん。

補足

修正どうもありがとうございます。

set book=workbooks.open filename:=mypath & myfileの部分でコンパイルエラーが起きてしまいます。
色々といじってみたのですが、知識不足で上手くいきませんでした。すみません。

また、（3 to 73)と("B:U")の部分はA列からBU列まで対象なのですが、("A:BU")にはならないのでしょうか。

ちなみに教えて頂いた、

activeworkbook.close false
を
book.close false
に変更。

の部分だけやってみたのですが、やはり何も実行されませんでした。
どうぞ宜しくお願い致します。

回答No.2

K Kazz（@JazzCorp）

作戦：結構高速版！！
１．データファイル（多分、多数のCSVファイル）を１つのフォルダ（例えば、d:\tmp）に集める。
２．cmdプロンプトのお世話になる。
→CD /d d:\tmp
→COPY *.CSV Alltogether.xls
３．Alltogather.xlsを開き列分割。
「N」が３つ揃った行を抽出して、削除。
欲しかったものが手に入る、オシマイ！！

回答No.1

INTLINSIDE

VBAでやるしかないのでは。

できないなら誰かに書いて（作って）もらうしか無いでしょう。
私も一応書けますが。

行と列の構造とか、ファイル名はどんな感じでしょうか。

何行目から始まって何行目で終わるとか。
何列目に質問があって何列目に回答があるとか。
半角なのか全角なのかとか、まあいろいろ細かい仕様がわからないと作れないんで。

時間あるなら自分でやってみてもいいと思う。
http://excelvba.pc-users.net/

４００ファイルとなると覚えて書いたほうがたぶん早い。