フォルダ内の全てのファイル開く時間短縮の方法

このQ&Aのポイント
  • Excelマクロを利用して、フォルダ内の全てのファイルを効率的に開く方法について説明します。
  • フォルダ内にある複数のファイルを一括で開くExcelマクロのコードを紹介します。
  • フォルダ内の全てのファイルを短時間で開くためのExcelマクロの設定方法を解説します。
回答を見る
  • ベストアンサー

フォルダ内の全てのファイル開く時間短縮の方法

Excelのマクロを使ってフォルダ内の全てのファイルを開く以下のコードを利用しているのですが(教えてgoo!で教えて頂いたコードです)、ファイル数が10個くらいあるため全部開くのに1分くらいかかってしまいます。 もっと時間を短縮することはできませんでしょうか? Sub OpenAllBook()   Dim FileName As String   Dim OpenedBook As Workbook   Dim IsBookOpen As Boolean   ChDir ("フォルダ名")   FileName = Dir("*.xls")   Do While FileName <> ""    If FileName <> ThisWorkbook.Name Then     IsBookOpen = False     For Each OpenedBook In Workbooks      If OpenedBook.Name = FileName Then       IsBookOpen = True       Exit For      End If     Next     If IsBookOpen = False Then      Workbooks.Open (FileName)     End If    End If    FileName = Dir()   Loop End Sub

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

  • ベストアンサー
  • nrb
  • ベストアンサー率31% (2227/7020)
回答No.1

もっと時間を短縮することはできませんでしょうか?  読み込みは早いですよ  ただ、読み込んだデータをセルの中に入れるの時間が掛かるのです  これで時間を食っているので・・・・  マクロでは解決できない問題です  解決するには  CPUの処理能力を上げる  メモリーが少ない時には増やす  しか 無いです  うちのファイル 馬鹿大きいの8MBのファイルを開けると  1分程度はCPU100%にされて開くまで掛かりますよ  1M程度項目全セル数20000程度で数秒は開くのに掛かる  まあ、エクセル自体の処理スピードの問題なのでマクロじゃどうにもなりません  

関連するQ&A

  • Excelのブック間の串刺し計算について

    Excelのブック間の串刺し計算について VBA超初心者です。同じフォルダ内にファイルがいくつかあり、同じ形式で、sheet1のB4のセルに計があったとして、それをブック間で串刺し集計したいのですが、うまくいきません。どこが悪いのかもわからず、困り果ててます。ご指導お願いします。 Sub BookShuukei() Dim FileName As String Dim Total As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean FileName = Dir("*.xls") Application.ScreenUpdating = False Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Total = Total + Workbooks(FileName).Sheets(1).Range("B4").Value If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.ScreenUpdating = True MsgBox (Total) End Sub

  • ファイル名が決まっていないファイルのデータを取り出しひとつのファイルにまとめる

    初めまして。 マクロ超初心者です。まだまだ勉強中でして自分で作るのは困難です。しかし、来月には必要なので… よろしくお願いします! エクセル2000で以下のマクロを作成したいです。 1.フォルダ内のCSVファイルを開き、中のデータをひとつにまとめる。 (フォルダ名とファイル名、ファイル数はその時によって変わってきます。ファイル数はだいたい10個くらいです。ひとつのデータは20列50行くらいで列の項目を基準にまとめたいです。) 2.列を1列目に挿入し、2列目と3列目のデータを1列目に統合する。 3.1列目のデータを使用し、重複を調べる。重複がある場合はどちらかひとつを削除する。(できれば4列目のデータを比較し数値が少ないほうを削除したいです。) ファイルを開くところまでは検索して探し当てたのですが、ファイル名が決まっていないことが難しく詰まってしまいます。 Sub OpenAllBooks() Dim filename As String Dim openedbook As Workbook Dim isbookopen As Boolean filename = Dir(ThisWorkbook.Path & "\*.csv") Do While filename <> "" isbookopen = False For Each openedbook In Workbooks If openedbook.Name = filename Then isbookopen = True Exit For End If Next If isbookopen = False Then Workbooks.Open (ThisWorkbook.Path & "\" & filename) End If filename = Dir() Loop End Sub 詳しい方よろしくお願いします!

  • vba で全てのエクセルファイルを開く処理

    お世話になります。 下記のVBAソースで、特定のフォルダにあるエクセルを全て 開く処理をしているのですが、スマートに行えているか 疑問に思いました。 具体的には、「'''''''''時間がかかっている??」箇所で 無駄なこと・時間がかかっていないか疑問です。 目的としては、「vba で全てのエクセルファイルを開く処理」ですので、 (1)皆さんがされている「vba で全てのエクセルファイルを開く処理」 (2)下記ソースの「'''''''''時間がかかっている??」は時間がかかっていないか の、どちらかで、結構ですのでご返事頂ければ有り難いです。 宜しくお願いします。 ------------ソース----------------- ChDir (ThisWorkbook.Path & "\" & フォルダ) fileName = Dir("*.xls") Do While fileName <> "" If fileName <> ThisWorkbook.Name Then IsBookOpen = False '''''''''時間がかかっている?? For Each OpenedBook In Workbooks If OpenedBook.Name = fileName Then IsBookOpen = True Exit For End If Next '''''''''時間がかかっている?? If IsBookOpen = False Then Workbooks.Open (fileName) End If End If fileName = Dir() Loop

  • ブックの集計方法について

    複数ファイルにある特定のシートのA列に記載がある時だけ、その行のA列からJ列までを、一つのファイルにコピーしたいと思っています。 ネットで調べてみたところ、エクセルで複数ファイルにある特定のシートの 特定した範囲を一つのファイルにコピーするマクロを探すことができました。 複数のシートから特定のシートのA列に文字がある場合は、J列までを一つのファイルの同じシートにコピーするようなことは出来ないでしょうか? (例えば、各ブックA列に10行ずつ文字がある場合は、このようなとりまとめをできないかと考えています。) ブック1(シート名:Q2)⇒集計シートのA1:J10 ブック2(シート名:Q2)⇒集計シートのA11:J20 ブック3(シート名:Q2)⇒集計シートのA21:J30 Sub ブック集合() Dim FileName As String Dim c As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean ChDir "c:/test" FileName = Dir("*.xls") Application.ScreenUpdating = False Application.DisplayAlerts = False c = 0 Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Workbooks(FileName).Sheets("Q2").Range("A1:J500 ").Copy _ ThisWorkbook.Sheets(3).Cells(c * 500 + 1, 1).PasteSpecial(xlPasteValues) c = c + 1 If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

  • EXcelマクロで同じフォルダ内のファイル全て開く。ドライブまたいでも対応

    以前以下のVBAを教えていただいたham-kamoさんに質問があります。もちろん違う方でも構いません。 「同じフォルダ内のブックを開くマクロ」についてですが、以下のVBAだとカレントフォルダをオプションで違うドライブに設定しているとうまく動作しないのですが、解決法はありますでしょうか? 例えば\\AAAA\BBというアドレスのフォルダ内にマクロを起動するファイルがあり、C:\Documents and Settings\XXXXがカレントフォルダに設定されるとC:\Documents and Settings\XXXX内のExcelファイルが開かれてしまうということです。 -------------------------- Sub OpenAllBooks() Dim FileName As String Dim OpenedBook As Workbook Dim IsBookOpen As Boolean ChDir (ThisWorkbook.Path) FileName = Dir("*.xls") Do While FileName <> "" IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If FileName = Dir() Loop End Sub

  • ファイル名のわからない複数のファイルをひとつにまとめる

    エクセル2000で以下のマクロを作成したいです。 1.フォルダ内のCSVファイルを開き、中のデータをひとつにまとめる。 (フォルダ名とファイル名、ファイル数はその時によって変わってきます。ファイル数はだいたい10個くらいです。ひとつのデータは20列50行くらいで列の項目を基準にまとめたいです。) 2.列を1列目に挿入し、2列目と3列目のデータを1列目に統合する。 3.1列目のデータを使用し、重複を調べる。重複がある場合はどちらかひとつを削除する。(できれば4列目のデータを比較し数値が少ないほうを削除したいです。) まだ途中までですが、マクロ作成してみました。 わたしとしては、フォルダ内のCSVファイルを開いてセルA1からデータの入った範囲をコピーし、testエクセルファイルのアクティブセルに貼り付け ↓↓↓ 次のファイルのデータをその下に貼り付けたいのでtestファイルのデータが入ったセルの下を選択し、ファイルを開くへ繰り返し。 のつもりなのですが…、うまく作動しません。 マクロのテキストを片手にネットでも検索しながら作ったのですが、まだ記述の仕方などがわかってなくどこがおかしいのかもわかりません。 わかる方がいたらよろしくお願いします! ----------------------------------- Sub ファイルのデータを統合() Dim filename As String Dim openedbook As Workbook Dim isbookopen As Boolean Dim myworksheet As Worksheets Dim myrange As Range filename = Dir(ThisWorkbook.Path & "\*.csv") Do While filename <> "" isbookopen = False For Each openedbook In Workbooks If openedbook.Name = filename Then isbookopen = True Exit For End If Next Range("A1").CurrentRegion.Copy Destination:=Workbooks("test.xls").Worksheets("sheet1").ActiveCell Workbooks("test.xls").Worksheets("sheet1").Range("A1").End(xlDown).Offset(1).Select If isbookopen = False Then Workbooks.Open (ThisWorkbook.Path & "\" & filename) End If filename = Dir() Loop End Sub

  • あるフォルダ内のすべての.xlsファイルを開いて印刷

    お世話になります。 エクセルVBAの質問です。 あるフォルダを指定して、その中のファイルを順番に開いて印刷したいと思っていますが、どのように記述したらよいのでしょうか。 下記、いろいろなところから引っ張ってきたのをつないだコードです。 すみませんが、ご教授願います。 Dim ShellApp As Object Dim oFolder As Object Dim targetFolderName As String Dim Xlname As String, Dpath As String, Opn As Integer Dim Fnd As Boolean Set ShellApp = CreateObject("Shell.Application") Set oFolder = ShellApp.BrowseForFolder(0, "フォルダ選択", 1) If oFolder Is Nothing Then Exit Sub End If targetFolderName = oFolder.items.Item.Path Dpath = "targetFolderName" Xlname = Dir(Dpath & "*.xls") Do While Xlname <> "" Opn = 0 Do Fnd = False For Each file_name In Windows If file_name.Caption = Xlname Then Fnd = True Exit For End If Next If Not Fnd Then If Opn = 1 Then Exit Do Workbooks.Open Filename:=Dpath & Xlname Opn = 1 End If ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Loop Xlname = Dir() Loop

  • VBA フォルダ内の複数Excelファイルを開く

    お世話になります。 XP エクセル2003使用です。 フォルダー内にある複数のすべてのエクセルを開くコードを 下記の解答をそのままコピーして実行しました。 (以下、このエクセルファイルを「実行ファイル.xls」と呼びます) http://okwave.jp/qa/q2598781.html (コードは最後尾に転記(※)) 問題点は、実行ファイル.xlsから実行した 開きたいエクセルファイルは、 Workbook_Open()で自動実行して、 最後に、ThisWorkbook.Closeで閉じるので、 マクロの実行がループの途中(1回目)で 実行ファイル.xls のコードの実行も終了してしますことです。 (実行ファイル.xls のファイルは開いたままです) つまり、ThisWorkbook.Closeでエクセルを閉じたときに マクロの実行までもが終わってしまうので、 実行ファイル.xlsに戻ってきません。 この問題を解決するための方法として 下記2点を調べましたが、力不足で自己解決できません。 --------------------- 1  実行ファイル.xls から開きたいエクセルファイルを開く時に 何かしらの命令文または引数を記述しておく。  → 解決のヒントを見つけることができませんでした。 --------------------- 2 実行ファイルをエクセルではなく、VBS(VBScript)で記述する。 この場合、参考にしたコードを、 VBS用に書き換えれば良いと思いますが、 VBSは記述したことがないので、さっぱりです。 方法として間違っていなければ、 できれば、どなた様か当該コードを VBS用で記述いただけませんでしょうか? --------------------- 一番良い方法が分からないので、 お力添えいただきたいのです。 よろしくお願いします。 --------------------- (※)参考コード --------------------- Sub OpenAllBooks()   Dim FileName As String   Dim OpenedBook As Workbook   Dim IsBookOpen As Boolean      FileName = Dir("*.xls")   Do While FileName <> ""     If FileName <> ThisWorkbook.Name Then       IsBookOpen = False       For Each OpenedBook In Workbooks         If OpenedBook.Name = FileName Then           IsBookOpen = True           Exit For         End If       Next       If IsBookOpen = False Then         Workbooks.Open (FileName)  ←この処理の後に戻ってこれません       End If     End If     FileName = Dir()   Loop End Sub

  • インプットボックスからファイルを開くようにしました。しかし、すでに開い

    インプットボックスからファイルを開くようにしました。しかし、すでに開いているか確認する項目がうまく作動しません。どのように記述するか教えて頂けませんでしょうか。 Sub Macro1() Dim wb As Workbook Dim psw As Boolean Dim fil As String fil = InputBox("ファイル名入力") For Each wb In Workbooks ’すでに開いているか確認。二重に開くのを防止 If wb.Name = "fil.xls" Then ’ここの部分がうまく作動してくれません。 psw = True Exit For End If Next wb If psw = False Then Workbooks.Open Path & "C:¥" & fil End If End Sub

  • VBAでフォルダにあるエクセルファイルを開く

    こんにちは このコードがうまく動かないのですが、 どこがいけないのかわからなく助けてください。 なおフォルダの中には******データ.xlsと言うファイルがあり、アスタリスク部分は日付が不規則に変化して上書きされるのです。 このファイルを開くマクロを作りたいのですが。 うまく行きません。 よろしくおねがいします。 Sub excelopen() ' ' Dim エクセル As String 'エクセル = Dir(ActiveWorkbook.Path & "\*データ.XLS") If エクセル = "" Then Exit Sub エクセル = ActiveWorkbook.Path & "\" & エクセル Workbooks.Open Filename:=エクセル End Sub