戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
指定フォルダのシートからリストを作成するには? P2

    [189425] 指定フォルダのシートからリストを作成するには? P2-

    ■親トピック/記事引用/メール受信=ON■

    □投稿者/ Que -(2019/05/31(16:26))
    □U R L/

      こんにちは
      今一度教えて下さい

      以前こちらで聞いた内容です
      htt p://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=188702&rev=0



      所定のフォルダ (例 C:\WORK\)
      【追加内容】
       この下に複数のフォルダがあります
       この複数のフォルダ配下の全てのエクセルをリストに書き出せませんか?

      シート一枚だけのエクセルが御座います
      これはファイル名称は法則性は無く、複数御座います
      約400件程

      以前は


      これらのエクセルはフォーマットは一定なので、指定のセルを
      エクセルの【Sheet1】のA2に書き出したいです

      書き出したい情報は各エクセルシートの
      元データ(固定):書出しセル(列固定:行変動)
      D5:A列 ・・ 2行目以降
      H5:B列
      J5:C列
      B17:D列
      I17:E列
      C20:F列


      作りたいLIST
      【Sheet1】
      【A】【B】【C】【D】【E】【F】
       A2 B2  C2 D2  E2 F2   ・・・ 元データセル(固定)
      あ  い  う え  お あ行   ・・・ エクセルファイル1
      か  き  く け  こ か行   ・・・ エクセルファイル2 
      さ  し  す せ  そ さ行   ・・・ エクセルファイル3


      全変数数字ありません

      こんな感じの事をしたいのですけど可能でしょうか?





    [189427] Re[1]: 指定フォルダのシートからリストを作成するには? P2-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2019/05/31(19:21))
    □U R L/
      要するに、
      "C:\Work"の配下のサブフォルダにあるエクセルファイルを対象にして
      なにがしかの作業を行いたいと、いうことですね。
      それなら、FileSystemObjectを使ったコードがよいと思います。
      作業そのものは前回のものを踏襲するのですね?
      そこは質問者さんが修正してください。
      
      Sub test()
          Dim fso  As Object
          Dim subf As Object
          Dim f As Object
      
          Set fso = CreateObject("Scripting.FileSystemObject")
       
          For Each subf In fso.GetFolder("C:\Work").SubFolders
              For Each f In subf.Files
                  Debug.Print f.Path                  'フルパスを返す
                  Debug.Print fso.GetExtensionName(f) '拡張子を返す
                  'ここで上のフルパス、拡張子を使って作業をします。
              Next
          Next
          Set fso = Nothing
      End Sub
      
      ht tp://officetanaka.net/excel/vba/filesystemobject/
      に情報と使用例がまとまっていますので、参考にして下さい。


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189447] Re[2]: 指定フォルダのシートからリストを作成するには? P2-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2019/06/05(22:53))
    □U R L/
      このような書き方ができると思います。
      
      Option Explicit
      
      Dim ws1 As Worksheet   'このブック(出力先)のワークシート
      Dim i As Long          '出力先ワークシートの行カウンタ
      
      Sub test()
          Const DEF_FLD As String = "C:\work"        '既定のフォルダパス
          Dim fso  As Object
          Dim subf As Object
          Dim f    As Object
          
          Application.ScreenUpdating = False
          Set ws1 = ThisWorkbook.Worksheets("Sheet1") '出力先シート
      
          '初期化と見出し行
          With ws1
              .Cells.Clear     'クリア
              .Cells(1, "A").Value = "A見出し"
              .Cells(1, "B").Value = "B見出し"
              .Cells(1, "C").Value = "C見出し"
              .Cells(1, "D").Value = "D見出し"
              .Cells(1, "E").Value = "E見出し"
              .Cells(1, "F").Value = "F見出し"
              .Cells(1, "X").Value = "ファイル名"
              .Cells(1, "Y").Value = "シート名"
          End With
      
          Set fso = CreateObject("Scripting.FileSystemObject")
      
          i = 2
          '指定フォルダのサブフォルダを順次取り出す
          For Each subf In fso.GetFolder(DEF_FLD).SubFolders
              'そのサブフォルダ内のファイルを順次取り出す。
              For Each f In subf.Files
                  'Excelファイルなら
                  If Left(LCase(fso.GetExtensionName(f)), 3) = "xls" Then
                      Call task(f.Path)
                  End If
              Next
          Next
          Set fso = Nothing
      End Sub
      
      Function task(pathname As String)
          Dim wb As Workbook
          Dim ws As Worksheet
          
          Set wb = Workbooks.Open(pathname)
      
          '各シートのデータを出力先に転記
          For Each ws In wb.Worksheets    'ブック内の全シートを走査します
              With ws
                  ws1.Cells(i, "A").Value = .Range("D5").Value
                  ws1.Cells(i, "B").Value = .Range("H5").Value
                  ws1.Cells(i, "C").Value = .Range("J5").Value
                  ws1.Cells(i, "D").Value = .Range("B17").Value
                  ws1.Cells(i, "E").Value = .Range("I17").Value
                  ws1.Cells(i, "F").Value = .Range("C20").Value
      
                  ws1.Cells(i, "X").Value = pathname  'ファイル名
                  ws1.Cells(i, "Y").Value = ws.Name   'シート名
              End With
              i = i + 1
          Next
          wb.Close
      End Function
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189823] Re[3]: 指定フォルダのシートからリストを作成するには? P2-

    保留中です・・・ / 記事引用/メール受信=OFF■

    □投稿者/ Que -(2019/07/12(11:32))
    □U R L/

      有難う御御座います

      \WORK>フォルダ1>フォルダ2

      これで【フォルダ1】まではLISTに書き出しています

      残念ながら【フォルダ2】のデータは書き出されていません

      此処も書き出す方法はどの様にすれば宜しいでしょうか?



      原状
      WORK>フォルダ1>フォルダ2
              >該当エクセルファイル

      があります

      更に
      WORK>フォルダ1>フォルダ2>フォルダ3
      の階層になりそうです


      指定のフォルダにある下層のサブフォルダ内のエクセルを全てLISTシートに書き出したいです




    [189838] Re[4]: 指定フォルダのシートからリストを作成するには? P2-

    記事引用/メール受信=OFF■

    □投稿者/ γ -(2019/07/12(22:06))
    □U R L/
      当初の質問はこうでした。
      > この下に複数のフォルダがあります
      > この複数のフォルダ配下の全てのエクセルをリストに書き出せませんか?
      
      この表現で普通想定するのは、以下のようなものです。
      <\work>── <subfolder1>
             |    └ file1
             |    └ file2
             └- <subfolder2>
                  └ file3
                  └ file4
      
      >  \WORK>フォルダ1>フォルダ2 
      ということなら、最初から
      「\workの2階層下のフォルダまでの各フォルダに含まれるファイル」
      と表現しなければ、相手には伝わりません。
      
      > 残念ながら【フォルダ2】のデータは書き出されていません
      「残念ながら」という表現は、そのままお返しします。
      
      -----------------
      それで、どうするかですが、
      ロシアの人形マトリョーシカのように、
      subfのSubFoldersの各フォルダに対して処理をするというように、
      入れ子にしていけばできます。
      ご自分で工夫してみてください。
      
      また、再帰処理にしてもよいでしょう。
      ネット上に色々ありますが、例えば、下記が参考になるでしょう。
      ht tps://www.moug.net/tech/exvba/0060088.html
      
      【追記】参照サイトを変えました。



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G