[[20210914144610]] 『VBAを使ったコピペが上手く動いてくれない』(Gettar) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『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


>>もこな2様

ご教授ありがとうございます。
'ブックを閉じるの前に張り付けを移動していみたのですが、相変わらず"実行時エラー1004"が発生します。
これはアクティブブックが新しく開いたcsvに映っているためでしょうか?
Thisworkbook では上手く行かなかったのですが、元のファイルにアクティブを戻す良い方法があれば教えてください。
(Gettar) 2021/09/14(火) 15:20


Sub CSVをすべて開いてコピペ()

    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


>>もこな2様
間違い箇所の指摘だけでなく見本の式まで書いていただき本当にありがとうございました。

>>メイプル様
見本にした式がRangeを使っていたのでそのまま使っていましたが、つい普段使っていたCellsの順で書いてしまっていました。
ご指摘ありがとうございました。
(Gettar) 2021/09/14(火) 17:24


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.