[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAを使ったコピペが上手く動いてくれない』(Gettar)
初めまして、現在作っているマクロが上手く動いてくれず、自力で解決できそうにないのでご相談させてください。
Sub CSVをすべて開いてコピペ()
Dim パス As String, ファイル As String
パス = "C:\test\" ファイル = Dir(パス & "*.csv") 'パス配下拡張子「.csv」の最初のファイル名を返す
Do While ファイル <> "" 'Dir関数がファイル名を返さなくなるまで繰り返す Workbooks.Open パス & ファイル 'ファイル名のブックを開く
Range("A1").Copy '開いたブックのA1をコピー
Workbooks(ファイル).Close 'ブックを閉じる ファイル = Dir '引数なしDir …引数を引き継いだ次のファイル名を返す Dim i As Long i = i + 1
Range(i, "C").PasteSpecial Paste:=xlValues 'C列に張り付け Loop
End Sub
やりたいことはtestフォルダ内のcsvファイルのA1の値のみをC列に抽出したいのですが、 'C列に張り付けの部分で"実行時エラー1004"が発生してしまいます。
改善点をご教授いただけますよう、よろしくお願いします。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
(もこな2) 2021/09/14(火) 15:06
ご教授ありがとうございます。
'ブックを閉じるの前に張り付けを移動していみたのですが、相変わらず"実行時エラー1004"が発生します。
これはアクティブブックが新しく開いたcsvに映っているためでしょうか?
Thisworkbook では上手く行かなかったのですが、元のファイルにアクティブを戻す良い方法があれば教えてください。
(Gettar) 2021/09/14(火) 15:20
Dim パス As String, ファイル As String Dim i As Long
パス = "C:\test\" ファイル = Dir(パス & "*.csv") 'パス配下拡張子「.csv」の最初のファイル名を返す
i = i + 1
Do While ファイル <> "" 'Dir関数がファイル名を返さなくなるまで繰り返す Workbooks.Open パス & ファイル 'ファイル名のブックを開く
Range("A1").Copy '開いたブックのA1をコピー
Workbooks("マクロシート.xlsm").Activate
Sheets("Sheet1").Range(i, "C").PasteSpecial Paste:=xlValues 'C列に張り付け
Workbooks(ファイル).Close 'ブックを閉じる ファイル = Dir '引数なしDir …引数を引き継いだ次のファイル名を返す
Loop
End Sub
いただいたアドバイスをもとに自分なりに修正してみたのですが、やはりエラーが発生してしまいます。
修正箇所をお教え願えませんでしょうか。
(Gettar) 2021/09/14(火) 16:49
■1
VBAの世界では基本的に、ブックやシート(オブジェクトと言います)をきちんと指定すれば、いちいちActiveにしたり選択したりする必要はありません。
また、【標準モジュール】でシートの指定を省略した場合「ActiveSheet」を指定したと見なされるルールです。
したがって、複数のブックやシート相手にするならば、きちんと指定すべきです。
■2
Do〜Loopの中に「Dim i As Long」のように変数の宣言がありますが、これはループの外に出すべきです。
■3
ということを踏まえるとこんな感じでよいと思います。
Sub 研究用1() Dim パス As String, ファイル As String Dim 出力行 As Long
Stop 'ブレークポイントの代わり
パス = "C:\test\" ファイル = Dir(パス & "*.csv") 出力行 = 1 Do While ファイル <> "" With Workbooks.Open(パス & ファイル) ThisWorkbook.Worksheets(1).Cells(出力行, "C").Value = .Worksheets(1).Range("A1") ThisWorkbook.Worksheets(1).Cells(出力行, "D").Value = .Name
.Close False '←必要な処理が終わってから閉じる End With
ファイル = Dir() 出力行 = 出力行 + 1 Loop
End Sub
■4
なお、CSVファイルとのことですからブックとして開かずに、テキストファイルとして扱うのもアリだと思います。
Sub 研究用2() Dim パス As String, ファイル As String Dim 出力行 As Long Dim FF As Long, buf As Variant
Stop 'ブレークポイントの代わり
パス = "C:\test\" ファイル = Dir(パス & "*.csv") FF = FreeFile 出力行 = 1
Do While ファイル <> "" Open パス & ファイル For Input As #FF Line Input #FF, buf ThisWorkbook.Worksheets(1).Cells(出力行, "C").Value = Split(buf, ",")(0) ThisWorkbook.Worksheets(1).Cells(出力行, "D").Value = ファイル Close #FF ファイル = Dir() 出力行 = 出力行 + 1
Loop End Sub
■5
テキストファイルの方は逐一出力するのでは無く、配列にいれて一気に出力することでさらなる処理速度アップが狙えるとは思います。
ただ、ちょっと難しくなるのでまずは興味が沸いたときに改めて研究してみるとよいと思います。
(もこな2) 2021/09/14(火) 17:04
横から失礼します。
修正後もエラーとなる直接の原因は >Sheets("Sheet1").Range(i, "C").PasteSpecial Paste:=xlValues 'C列に張り付け ↑ ここのRangeの書き方が間違っているからでは?
.Cells(i,"C")とするか、.Range("C" & i) とするかでしょう。
(メイプル) 2021/09/14(火) 17:16
>>メイプル様
見本にした式がRangeを使っていたのでそのまま使っていましたが、つい普段使っていたCellsの順で書いてしまっていました。
ご指摘ありがとうございました。
(Gettar) 2021/09/14(火) 17:24
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.