質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.61%

VBAファイル操作の高速化

解決済

回答 4

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 17K+

score 24

あるディレクトリにあるすべてのファイルを開いて必要個所をコピーし、一つのブックにまとめる作業をしています。
しかしこの作業が非常に時間がかかります。フォルダ内50程度のファイルでも1~2分。最終的に1000ファイル位を扱うことを考えると、少しでも高速化したいところです。どなたかお知恵を拝借できませんか。

大変失礼しました。
Application.ScreenUpdating = False
Application.ScreenUpdating = True
のセットが抜けておりました。描写非表示でなおかつ高速化の手順があればご教示願います。

Sub 各ブック必要個所集合()
    Application.DisplayAlerts = False

    Dim dlg As FileDialog
    Dim fold_path As String, i As String

     Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

    ' キャンセルクリック処理
     If dlg.Show = False Then Exit Sub

    ' フォルダフルパスを変数格納
     fold_path = dlg.SelectedItems(1)

    Set mb = ThisWorkbook
    myfdr = ThisWorkbook.Path
    fname = Dir(fold_path & "\*.xls")
    Do Until fname = Empty
    If fname <> mb.Name Then
    Application.EnableEvents = False
    Set wb = Workbooks.Open(fold_path & "\" & fname)
    Application.EnableEvents = True

    Sheets("あああああ").Visible = True

    Worksheets("あああああ").Select
    Range("e2:e633").Copy
    mb.Activate
    Worksheets("いいいいい").Select
    Cells(1, 10000).End(xlToLeft).Offset(0, 1).Select
    ActiveCell.Value = x & wb.Name
    ActiveCell.Offset(1, 0).PasteSpecial xlPasteAll
    wb.Close
    End If
    fname = Dir
    Loop

End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 4

checkベストアンサー

0

処理中の内容を表示しないようにするのが一番効果的です。
以下参考
エクセルVBA高速化ランキング【第1位】

追記

コピーの部分は多少短縮できると思います。
無駄なSelectをしない

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/10/21 14:45

    いえ、ほかには割愛している箇所はありません。
    無駄なアクセスをしないということであれば、開いたブックの必要範囲を2次元配列にして最終的に書き出しをしたほうが良いかと気づかされました。
    もう少し回答をお待ちしてみます。
    ご回答ありがとうございます。

    キャンセル

  • 2018/10/21 14:55

    一旦配列に入れるのは無駄だと思います。
    追加したリンク先の最後の方を参照して下さい。

    キャンセル

  • 2018/10/21 19:27

    selectとはアクセスとも違う部分があるんですね、勉強になりました。具体的なコードを提示してくださった方もありますが、お教示いただいたことが勉強になりましたのでBAとさせていただきます。

    キャンセル

0

FSOのファイル検索は高速とはいいがたいので、コマンドであらかじめファイルパスの取得をして、
配列に放り込んでおくとかなり高速化できるのではないかと思います。

Dim WSH, FilePath
Set WSH = CreateObject("WScript.Shell")

FilePath = WSH.Exec("dir """& fold_path &""" /s /b /a-d").StdOut.ReadAll
FilePath = Split(FilePath, vbCrLf) ''最終行が空で入るので気を付けてください

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/10/21 19:26

    ご回答ありがとうございます。
    これ、挑戦してみたかったんですよね。なるほどファイル検索部分での短縮ですか。勉強になります。ちょっと参考にさせていただいて学習します。

    キャンセル

0

あるファイルとは、どんな形式ですか?EXCEL、CSV、PRN、RDB??

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/10/21 18:48

    コード中に
    fname = Dir(fold_path & "\*.xls")
    とあります。

    キャンセル

0

Option Explicit
Sub 各ブック必要個所集合()
    Dim dlg As FileDialog
    Dim fold_path As String
    Dim Sh As Worksheet
    Dim Col As Long
    Dim fname As String
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    If dlg.Show = False Then Exit Sub       ' キャンセルクリック処理
    fold_path = dlg.SelectedItems(1)        ' フォルダフルパスを変数格納
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set Sh = ThisWorkbook.Worksheets("いいいいい")
    Col = Sh.Cells(1, Sh.Columns.Count).End(xlToLeft).Column
    fname = Dir(fold_path & "\*.xls")
    Do Until Len(fname) = 0
        If fname <> ThisWorkbook.Name Then
            With Workbooks.Open(fold_path & "\" & fname, ReadOnly:=True)
                Col = Col + 1
                Sh.Cells(1, Col).Value = fname
                Sh.Cells(2, Col).Resize(632).Value = .Worksheets("あああああ").Range("E2:E633").Value
                .Close
            End With
        End If
        fname = Dir
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/10/21 19:25

    なるほど、selectしないアクセスしないというのがよくわかりました。50件程度でも数秒単位で差がわかりました。ありがとうございます。

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.61%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る