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

このQ&Aのポイント
  • VBAを使用して特定のフォルダにあるすべてのエクセルファイルを開く処理について、効率性や実行時間に関して疑問があります。
  • 具体的には、無駄な処理や時間のかかり方について検討したいです。
  • 目的は、VBAを使用してすべてのエクセルファイルを開くことであり、他の方法や実装例についても教えていただけると助かります。
回答を見る
  • ベストアンサー

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

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

  • ベストアンサー
  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.4

#1-3、cjです。#3訂正です。 > こんな風なシンプルな記述でも、二重起動することがありませんから、 > 問題になることはありません。 この記述は(私の認識の)誤りでした。 問題にならないのは、運用ルールによるものでした。 当方の環境でもやはり問題になる場面はあります。 開いていたブックと同一のブックを再度開こうとする場合、 開いていたブックに未保存のデータがあると、 ーーーーーーーーーーーーーーーーーーーーーーーーー "ブック名 .xlsは既に開いています。2乗に開くと、これまでの変更内容は破棄されます。ブック名 .xls を開きますか?" [はい] [いいえ] ーーーーーーーーーーーーーーーーーーーーーーーーー というダイアログが表示され、 実行を中断せざるを得なくなります。 という訳で、ブックを開く前のタイミングで上書き保存してあれば、問題ない、 という但し書きを付けておくべきでした。 または、考えようによっては、予め、自ブック以外のブックをすべて閉じておいて それから一気に全部開く、などの方法も、検討に値するかも知れません。 以上、訂正でした。失礼しました。

kgyqk433
質問者

お礼

ありがとうございます!! 元からあったソースを使っていたのですが、疑問がとけました!!! 単純に開く形に変えたいと思います!! ありがとうございます!!!!

その他の回答 (3)

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.3

#1、2、cjです。#2お礼欄へのレスです。 適切な答えになるか判りませんが、 「二重起動を避ける」 「シンプルな記述と遅い処理を避ける記述」 という2つの観点でお応えします。 例えば私の場合、現在は開発環境も運用環境も共に、64ビット版Excel2010 で、統一されているので、そこに甘んじて簡略化を図るなら、 ' ' /// Sub Re8338991b()   Const フォルダ As String = "q8338991\"   Dim FileName As String   ChDir (ThisWorkbook.Path & "\" & フォルダ)   FileName = Dir("*.xls")   Do While FileName <> ""     Workbooks.Open FileName     FileName = Dir()   Loop End Sub ' ' /// こんな風なシンプルな記述でも、二重起動することがありませんから、 問題になることはありません。 しかし、拡張子が".xls"ということは、 Excel2003以前の環境への互換を配慮するべき、という意味ですから、 二重起動を避ける記述は必要だと思います。 私周辺の昨年までの環境はExcel2000でしたが、この場合は、 確実にブックの二重起動を回避する必要がありました。 #2お礼欄の2つめのコード「-ネットで見たソース-」について 「全部開く」という場合、 例えば読み取りだけを目的としていて、 二重起動そのものがトラブルの原因にならないような アプリケーションやファイル形式ならば、 目を瞑って全部開いちゃっても構わないと思います。 どの環境、どんなファイルなら大丈夫なのか、 試しに手作業で二重起動してみれば、 必要かどうかの判断が出来るのではないでしょうか。 ファイルAをふたつ開いて、ファイルA(1)、ファイルA(2)、という状態で、 ファイルA(1)を書き換えて保存したとして(それが許されるアプリケーションだとして) ファイルA(2)には反映されない処理があることが問題で、 これを上書き保存すれば、酷いことになります。 シンプルに書くことができて、しかも、無駄なく処理が速い、 という記述があれば、それは理想的ですよね。 実践ではそうはならない場面の方が多いと考えた方がいいと思います。 例えば、当初ご提示の   Do While fileName <> ""   If fileName <> ThisWorkbook.Name Then についていえば、記述の簡潔さという意味では問題ないのですが、 Dir()関数でファイル名が見つかった回数だけ、 「ThisWorkbookオブジェクトにアクセスする」「.Nameプロパティを取得する」 ということを繰り返していることになります。 これを   Dim ThisName As String   ThisName = ThisWorkbook.Name   Do While fileName <> ""   If fileName <> ThisName Then のように書けば、 「ThisWorkbookオブジェクトにアクセスする」「.Nameプロパティを取得する」 1回で済むことになります。 繰り返し参照する(比較に用いる)(固定的な)値は、予め変数に格納しておく、 というのは、一般論としてプログラミングの基本だと思います。 変数を使うことに慣れた人からすれば変数を使ってくれた方が 可読性が高く感じられる場合が多いようにも思います。 まぁ、ThisWorkbook.Nameの取得自体はそれほど時間をロスするものではありませんが   For Each OpenedBook In Workbooks   If OpenedBook.Name = fileName Then   IsBookOpen = True   Exit For   End If   Next というループを、Dir()関数でファイル名が見つかった回数だけ、繰り返すのは、 大きく時間をロスすることになります。 なので、予め変数に格納しておいて、ループ内では変数を基準に判別するように書き換えたのが #1のSub Re8338991a()です。 この記述について、または、用語について、誤解があるようですが、 ExcelやExcel VBAでの用語としての"配列"は今回、扱っていませんので、一応、念の為。 それから、 > 下記の「ネットで見たソース」は、ファイルを探す処理は > 下記の形でシンプルだったのですが、 "ファイルを探す処理"自体は、どの記述でも変わりないです。 その点は整理して考えてください。 見つかったファイル名に対して、 必要に応じて、条件分岐する場合、の記述が、 そちらで思うように(ご本人が納得がいくように)書けていない、 ということなのだと思います。 > 組み込まないといけないのでしょうか? どう書くかの話は置いといて、 二重起動を回避するかどうかは、 どちらかといえばキチンと書くことをお奨めしますが、 最終的には、そちらで判断してください。 環境によって、そもそも書かないといけない場合もありますし、 現在の私のように必要はないけれど、備えとして書く(書くべきと考える)、場合もあります。 以上、答えになっているといいのですが、、、。

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.2

#1、cjです。#1への追加レス、補足です。 すみません。書き忘れました。 ご提示の If fileName <> ThisWorkbook.Name Then についてですが、 Dir()関数でブック名を探すフォルダが ThisWorkbook.Path & "\" & フォルダ というように一階層下のフォルダになっていますから、 普通は、ThisWorkbook.Nameにヒットすることは無いようにも思います。 ただ、中には一階層下に同名の別ファイルを置くような使い方もあるでしょうから、 こちらが書いたものも、念の為、合わせて書いています。 不要と判断出来たら、その部分の記述は削除してください。

kgyqk433
質問者

お礼

ご連絡ありがとうございます。 追加で疑問なのですが、 下記の「ネットで見たソース」は、ファイルを探す処理は 下記の形でシンプルだったのですが、 教えて頂いた配列や、元記載の一度開いたか確認する箇所は 組み込まないといけないのでしょうか? ネットで見たソースで、不具合なければ、一番処理が 早そうだったので。。。。 ---------一度開いたか確認する箇所---------- '''''''''時間がかかっている?? For Each OpenedBook In Workbooks If OpenedBook.Name = fileName Then IsBookOpen = True Exit For End If Next '''''''''時間がかかっている?? -------------------------------- ----------------ネットで見たソース---------------------- Do While strFileName <> "" ' 検索した1ファイル単位の処理 ' 次のファイル名を参照 strFileName = Dir Loop

  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.1

こんにちは。 2例挙げておきます。 まずはご提示の方法を踏襲して無駄を削いでみます。 毎回Workbooksを総なめする必要はないですから、 予め、開いているブックの名前をリストにしておきます。   sBuf = sBuf & vbLf & wbk.Name ...   sBuf = sBuf & vbLf という記述でラインフィードに区切られ囲まれたブック名 の直線的なリストが文字列変数sBufに、格納されます。     If InStr(sBuf, vbLf & FileName & vbLf) = 0 Then FileNameの前後をラインフィードで挟んだ文字列が sBufに見つからないなら、ブックは開いていない、と。 ' ' /// Sub Re8338991a()   Const フォルダ As String = "q8338991\"   Dim wbk As Workbook   Dim sBuf As String   Dim ThisName As String   Dim FileName As String   ThisName = ThisWorkbook.Name   For Each wbk In Workbooks     If wbk.Name <> ThisName Then sBuf = sBuf & vbLf & wbk.Name   Next   sBuf = sBuf & vbLf   ChDir (ThisWorkbook.Path & "\" & フォルダ)   FileName = Dir("*.xls")    Application.ScreenUpdating = False   Do While FileName <> ""     If InStr(sBuf, vbLf & FileName & vbLf) = 0 Then Workbooks.Open FileName     With Workbooks(FileName)       If .Name <> ThisName Then         ' ' 処理         Debug.Print .Name  '  サンプル上の仮の処理         .Close  '  サンプル上の仮の処理(閉じても良いならひとつずつ閉じる)       End If     End With     FileName = Dir()   Loop Application.ScreenUpdating = True End Sub ' ' /// ' 次に、私がよくやる方法。 ' ' /// Sub Re8338991j()   Const フォルダ As String = "q8338991\"   Dim sBuf As String   Dim ThisName As String   Dim FileName As String   ThisName = ThisWorkbook.Name   ChDir (ThisWorkbook.Path & "\" & フォルダ)   FileName = Dir("*.xls") Application.ScreenUpdating = False   Do While FileName <> "" On Error GoTo NotOpen_     With Workbooks(FileName) On Error GoTo 0       If .Name <> ThisName Then         ' ' 処理         Debug.Print .Name         .Close       End If     End With     FileName = Dir()   Loop Application.ScreenUpdating = True Exit Sub NotOpen_:   Workbooks.Open FileName   Resume End Sub ' ' /// 処理を速くする、ということだと、 一度に開いているブックは少ない方が有利ではありますので、 全体の設計との兼ね合いで、許されるなら ひとつずつ開いて閉じることを検討してみるといいかも、です。 後は、Application系の、 EnableEventsとかCalculation等々、遅くなる原因になり易い Excel側の処理要求を予め抑制しておく、とか。 ExcelバージョンやOS(グラフィック環境)によっては Application.WindowStateを一時的に最小化するとか、 Applicationの.Leftや.Topを弄って一時的にモニターに表示できないようにする とか、昔はやってました。 私自身は最近、あまりブックを開くことに拘る必要がなかったので、 ここ数年の事情はあまりよく知りませんが、Excel2010までなら、 或いはExcel2013でも部分的には、まぁ通用する話ではあるでしょう。 以上です。

関連するQ&A

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

    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

  • 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 詳しい方よろしくお願いします!

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

    複数ファイルにある特定のシートの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

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

    エクセル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

  • 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

  • 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

  • EXCELのVBAを使用してフォルダー内の複数のデーターの集計処理を

    EXCELのVBAを使用してフォルダー内の複数のデーターの集計処理を 行いたいのですが1個目のデーター処理を行った後集計処理を行った後 集計シートを2個目のデーターに移動させたいのですが方法がわかりません。 下記のように集計表(原紙)を複数のデーターにコーピーはできるのですが Private Sub CommandButton1_Click() '集計表作成 Dim MyPath, MyBook, MyName MyPath = ThisWorkbook.Path & "¥" MyBook = ThisWorkbook.Name MyName = Dir(MyPath & "*.xls") Do While MyName <> "" If MyName <> MyBook Then Workbooks.Open Filename:=MyPath & MyName '一番左に集計表を貼り付ける Workbooks(MyBook).Worksheets(1).Copy Before:=Workbooks(MyName).Sheets(1) '"ここで集計処理後 次のBookへ移動" Workbooks(MyName).Save Workbooks(MyName).Close End If MyName = Dir Loop End Sub Copy部分をMoveにするとエラーメッセージがでてしまい 集計したシートを次々と移動させる方法がわかりません。 どのような方法で実行すれば宜しいでしょうか?

  • excelのファイルとセル値を書き出したい

    excel2003を利用しています。 とあるフォルダにある excelファイル名(自分自身のファイルを除く) を全て書き出して、 且つ A1セルの値をB列に書き出すことを、やろうとvbaを作ってみましたが。 最後のファイルのA1セルを書きだすところで、エラーになっていまい そこだけ空白になってしまいます。※写真参照 記述は以下の通りです。どのように修正すればよいか 教えていただけないでしょうか? また他にもっと優れた記述があれば、そちらも教えて欲しいです。 よろしくお願いします。 Sub test() Dim buf As String, cnt As Long Dim Path As String Path = ThisWorkbook.Path & "\" buf = Dir(Path & "*.xls") cnt = 2 Do While buf <> "" If buf <> ThisWorkbook.Name Then cnt = cnt + 1 Cells(cnt, 1) = buf buf = Dir() Workbooks.Open Filename:=Path & "\" & buf MsgBox Workbooks(buf).Worksheets(1).Range("A1").Value Cells(cnt, 2) = Workbooks(buf).Worksheets(1).Range("A1").Value Workbooks(buf).Close End If Loop End Sub

  • エクセルVBAで、ある条件の時

    お世話になります。 エクセルVBAで次のようなことをしたいのですが方法を教えてください。 formフォルダにあるすべてのファイルについて、A1セルが「0」でないとき、 A4:B7及びA9:B12の中で日付が入っている行の日付と内容を、ActiveWorksheetのB列、C列にレコードとして取り出したいのです。 (A列はナンバリングになります) --------formフォルダの中にあるブック---------   A  B 1 23 2 3 日付 内容   'この行は固定です 4 5/13 あああ 5 5/17 いいい 6 7 8 日付 内容   'この行は固定です 9 5/16 ううう 10 5/12 えええ 11 12 5/10 おおお ---ThisWorkbook(前に助けていただいたコードです)--- Sub data_torikomi2()   Dim wb As Workbook   Dim Fn As String   Dim myPath As String   Dim dbBkSh As Worksheet   Dim i As Long   For Each wb In Workbooks     If wb.Name <> ThisWorkbook.Name And _     InStr(1, wb.FullName, "form\", 1) > 0 Then 'formを検索       wb.Close '閉じる     End If   Next wb   myPath = ThisWorkbook.Path & "\"   Set dbBkSh = ThisWorkbook.Worksheets("一覧表")          Range("4:1000").Clear '全データ削除   Fn = Dir(myPath & "form\*.xls")   i = 1   '画面のちらつきを抑える   Application.ScreenUpdating = False   Do Until Fn = ""     If Fn <> ThisWorkbook.Name Then       With Workbooks.Open(myPath & "form\" & Fn, , True)         dbBkSh.Range("A3").Offset(i, 0).Value = i     【★たぶんこの部分に入るものです★】         .Close False         i = i + 1      End With     End If     Fn = Dir()   Loop   Application.ScreenUpdating = True   Set dbBkSh = Nothing End Sub ご教示よろしくお願いします。

専門家に質問してみよう