こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

複数のtxtの特定部分を抽出し、一つのxlsファイルにまとめたいです。

複数のtxtの特定部分を抽出し、一つのxlsファイルにまとめたいです。
皆様のお知恵をお借りできませんでしょうか?

現在約1000行からなる同一体裁のtxtファイルを多数所持しております。

中身はタブで区切ってあったので、タブをコンマに変換し、CSVファイルを作りました。
これらのファイルを15~20ファイルごとにフォルダ分けしてあります。
このCSVファイルをエクセルで開いたところ、
うちB601:B802に必要な情報が入っていました。
この情報を以下のような要領で入力したまとめxlsファイルを作りたいです。

A列
1行目 一つ目のCSVのファイル名(フォルダ内のCSVを名前順で並べたときに1番上のもの)
2行目~203行目 一つ目のCSVのファイルのB601:B802

B列
1行目 2つ目のCSVのファイル名(名前順で2番目のもの)
2行目~203行目 2つ目のCSVのファイルのB601:B802

(以後15~20ファイル分、O~T列まで。20ファイル以上にも対応できると嬉しいです。)

このxlsファイルを最低でも20個作る予定です。

VBAマクロできっと出来るはずと思い、昨日9時間ほど調べたのですが、習得には至ってません。
例えば1つのCSVのB601:B802をコピーするマクロは作成できますが、
それをまとめファイルのA2に貼り付け、
まとめファイルのA1にCSVのファイル名を挿入し、
さらに同様の抽出をフォルダ内の別のファイルに連続して行い、
挿入部位が被らないようにまとめファイルB列以降に貼り付けさせることができません。

http://www.asahi-net.or.jp/~zn3y-ngi/YNxv252.html
http://oshiete1.goo.ne.jp/kotaeru.php3?q=359726
http://www.excel.studio-kazu.jp/kw/20080428180002.htmlなどを
応用できないか試してみましたが結局よくわからない状態です。
おそらくこちらの説明が不十分で答えにくい質問なのではないかと思いますが、
どなたかお答えいただければ幸いです。

また、勉強してから出直せ!的なことであれば勉強したいとおもいますので、
お勧めの書籍、サイトを教えていただければ幸いです。
どうかよろしくお願いいたします。

投稿日時 - 2010-03-08 01:23:45

QNo.5734054

暇なときに回答ください

質問者が選んだベストアンサー

処理する順番が決っていないのでしたら
DIR関数とループを上手く使えば良いかもです。
(手抜きなサンプルですが)
strFileName = Dir("C:\TEMP\*.CSV", vbNormal)
i = 0
Do While strFileName <> ""
 'ファイル開く(省略 ※エラーなら抜けないとですが)
 'コピー(省略)

 'ペースト
 Sheets("コピー先").range("A2").offset(0,i).pastespecial
 i = i + 1

 '次のファイル名
 strFileName = Dir()
Loop

決っていないなら
iColumn = .Cells(iRows, .Columns.Count).End(xlToLeft).Column
if .Cells(1,iColumn) = "" then
 iColumn = iColumn + 1
end if
とかでカラム位置を求めるしかないかもです。

投稿日時 - 2010-03-08 12:13:05

補足

ありがとうございます!

実は質問の後、http://www.moug.net/tech/exvba/0060001.htmを参照して
自分なりに作ってみましたが、動きません。
(エラーもはき出さず、白紙のエクセルのまま。)
正直どこがダメなのか、皆目検討がつきません。
mo2yakkoさんのアドバイスをどのように生かせばよいのかもわかりません。
どなたかご教授願えませんでしょうか?


Sub sample()
 Dim myPath As String
 Dim myFName As String
 Dim FCnt As Integer

 ThisWorkbook.Activate '使うブックをアクティブに
 myPath = ActiveWorkbook.Path 'そのパスを定義
 ChDir myPath 'そのパスのフォルダに移動

 FCnt = 0 '取得ブック数をカウントするための変数を初期化
 myFName = Dir("*.csv") 'Dir関数で最初のファイルを選択

 If myFName <> "" Then 'ブックが取得できた場合
  FCnt = FCnt + 1 'カウントをプラス
  Workbooks.Open Filename:=myFName 'ファイルオープン
  Range("B601:B802").Copy '必要部分のコピー
  ActiveWorkbook.Close 'データファイルを閉じる
  ThisWorkbook.Activate 'まとめブックをアクティブに
  Cells(1, FCnt).Value = myFName 'まとめ一行目にファイル名を挿入
  Range(Cells(2, FCnt), Cells(6002, FCnt)).PasteSpecial Paste:=xlPasteValues '二行目から値のみ貼り付け(一つのデータ終了)

  Do
   myFName = Dir("*.xls") 'Dir関数で次のファイルを選択
   If myFName <> "" Then 'ブックが取得できた場合
   FCnt = FCnt + 1 'カウントをプラス
   Workbooks.Open Filename:=myFName 'ファイルオープン
   Range("B601:B802").Copy '必要部分のコピー
   ActiveWorkbook.Close 'データファイルを閉じる
   ThisWorkbook.Activate 'まとめブックをアクティブに
   Cells(1, FCnt).Value = myFName 'まとめ一行目にファイル名を挿入
   Range(Cells(2, FCnt), Cells(6002, FCnt)).PasteSpecial Paste:=xlPasteValues '二行目から値のみ貼り付け(一つのデータ終了)
   Else
   Exit Do
  End If
  Loop
 End If
End Sub

投稿日時 - 2010-03-08 17:44:39

お礼

さらにmo2yakkoさんのアドバイスを取り入れた結果、
なんとか狙い通りのマクロを組むことが出来ました!
本当にありがとうございます!

投稿日時 - 2010-03-09 06:18:59

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問