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

    [195194] 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ おりふぃす -(2022/09/02(14:25))
    □U R L/
      @フォルダに存在するCSVファイル(ファイル数は動的であり、データ配列は1列とする)を開き、各ファイルの最終行数とCSVファイル名を取得する。
      *フォルダ名は動的である
      
      A最終行数の値を、別名のExcelシートに貼り付ける。
      
      Bこの操作(@とA)をフォルダAに保存されるCSVファイル数を繰り返す
      
      かなり雑多にプログラムを作成したのですが、うまくいかないです。
      FSO FileSystemObjectはあまりVBAmacroで活用したことがなく、
      使いこなせていない部分が大きいと思います。
      ご教授を頂ければ幸いです。何卒よろしくお願い申し上げます。
      (下記に作成途中のプロシージャを掲載させていただきます)
      ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
      
      
      Sub Csvファイルをエクスポートver5()
          
          Dim A_Sheet  'Excelファイルのシート名を入れ込む変数'
          Dim Csv_Import_File  'Excelファイルに取り込むCSVファイルの名前を入れ込む変数'
          Dim Count As Long, Total As Long
          Dim File_Path As String
          Dim FSO As Object, f As Variant, BaseNames() As String, cnt As Long
          Dim i As Long
          
          A_Sheet = ActiveSheet.Name  '現在アクティブなシート名を変数 A_Sheet に入れ込む'
          
          Csv_Import_File = Application.GetOpenFilename("CSVファイル,*.csv")  'CSVファイルを選択する'
          If Csv_Import_File = "False" Then Exit Sub  'キャンセルなら終了'
          
          Count = InStrRev(Csv_Import_File, "\")
          Total = Len(Csv_Import_File)
          File_Path = Left(Csv_Import_File, Count - 1)
          'Debug.Print "File_Path:"; File_Path
          
          Set FSO = CreateObject("Scripting.FileSystemObject")
              For Each f In FSO.GetFolder(File_Path).Files
                  ReDim BaseNames(FSO.GetFolder(File_Path).Files.Count)
                  If LCase(FSO.GetExtensionName(f.Name)) = "csv" Then
                      cnt = cnt + 1
                      BaseNames(cnt) = FSO.GetBaseName(f.Name)
                      'Debug.Print "File_Path:"; File_Path
                      'Debug.Print "f.Name:"; f.Name
      
                      'Debug.Print "cnt:"; cnt
                      'Debug.Print "BaseNames(cnt):"; BaseNames(cnt)
                  End If
              Next
      
                  For i = 1 To cnt
                  
                          Debug.Print "cnt:"; i
                          Debug.Print "BaseNames(cnt):"; BaseNames(i)
                                                         
                          ThisWorkbook.Sheets("データ取込み").Range("A1:ZZ100000").ClearContents  '「データ取込み」シートのセル「A1〜ZZ100000」をクリアする'
          
                          'With Workbooks.Open(BaseNames(cnt))
                              'Debug.Print "With Workbooks.Open(BaseNames(i))⇒"; BaseNames(i)
                              '.Sheets(1).Cells.Copy ThisWorkbook.Sheets("データ取込み").Range("A1")  '全てのデータをこのブックの「データ取込み」シートにコピー'
                              '.Close  'CSVファイルを閉じる'
                          'End With
      
                          With ActiveSheet
              
                              .Cells(Rows.Count, 1).End(xlUp).Copy '元シートの指定行数分コピーします'
      
                              Sheets("データ抽出").Cells(i + 1, 2).PasteSpecial Paste:=xlPasteValues '別シートへ値のみ貼り付けします'
      
                              Application.CutCopyMode = False '範囲選択を解除します'
          
                          'End With
          
                          'Debug.Print "A_Sheet:"; A_Sheet
                          'Debug.Print "Csv_Import_File:"; Csv_Import_File
          
                          'Debug.Print "Count:"; Count
             
                          Sheets("データ抽出").Cells(i + 1, 1) = Right(Csv_Import_File, Total - Count)
                          
                          End With
                  Next
                  'End If
          Set FSO = Nothing
      End Sub
      


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

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




    [195195] Re[1]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マナ -(2022/09/02(14:37))
    □U R L/
      >ReDim BaseNames(FSO.GetFolder(File_Path).Files.Count)
      
      ループの中にあって大丈夫ですか?
      


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

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




    [195196] Re[2]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マルチネス -(2022/09/02(15:00))
    □U R L/

      一応、こちらもあちらもマルチポストは
      禁止されています。




    [195197] Re[3]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ おりふぃす -(2022/09/02(15:26))
    □U R L/

      ↑ご指摘ありがとうございます。




    [195198] Re[4]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マナ -(2022/09/02(16:01))
    □U R L/
      では、こちらは不要スレということで、要望と違う回答を。
      (あちらってどこ?)
      
      Power Query
      let
          ソース = Folder.Files("D:\***\****\****"),
          フィルターされた行 = Table.SelectRows(ソース, each [Extension] = ".csv"),
          追加されたカスタム = Table.AddColumn(フィルターされた行, "カスタム", each Csv.Document([Content],[Delimiter=",", Columns=1, Encoding=932, QuoteStyle=QuoteStyle.None])),
          追加されたカスタム1 = Table.AddColumn(追加されたカスタム, "行数", each Table.RowCount([カスタム])),
          削除された他の列 = Table.SelectColumns(追加されたカスタム1,{"Name", "行数"})
      in
          削除された他の列
      




    [195199] Re[5]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ おりふぃす -(2022/09/02(16:11))
    □U R L/

      もう一方はすでにスレ削除してます。
      Excel Q&Aサロンに挙げている方にて回答を宜しくお願いします。




    [195201] Re[6]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マナ -(2022/09/02(16:41))
    □U R L/

      参考になるのでは↓

      CSVファイルの行数を取得する
      ht tps://www.moug.net/tech/exvba/0060083.html




    [195202] Re[7]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マナ -(2022/09/02(18:41))
    □U R L/
      >各ファイルの最終行数とCSVファイル名を取得する。
      
      取得したいのは 行数 と思いこんでいましたが、
      コードをみると
      
      >.Cells(Rows.Count, 1).End(xlUp).Copy '元シートの指定行数分コピーします'
      
      一番下の値を取得したいのでしょうか?
      
      let
          ソース = Folder.Files("D:\***\****\****"),
          フィルタ = Table.SelectRows(ソース, each [Extension] = ".csv"),
          Data取得 = Table.AddColumn(フィルタ, "Data", each Csv.Document([Content],[Delimiter=",", Columns=1, Encoding=932, QuoteStyle=QuoteStyle.None])),
          最終行 = Table.AddColumn(Data取得, "最終行", each Table.LastN([Data],1)),
          削除された他の列 = Table.SelectColumns(最終行,{"Name", "最終行"}),
          #"展開された 最終行" = Table.ExpandTableColumn(削除された他の列, "最終行", {"Column1"}, {"最終値"})
      in
          #"展開された 最終行"
      




    [195204] Re[8]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ おりふぃす -(2022/09/02(19:58))
    □U R L/

      説明不足でした。すいません。
      CSVファイルのイメージを下記にお示しします。
      A    B    C    ……
      1 69 0.939 1.468 0.681 0.92
      2 63 1 1.217 0.821 0.947
      3 40 0.77 1.552 0.644 0.899
      4 33 0.82 2.136 0.468 0.957
      ///////////////////中略///////////////////////
      67 30 0.952 1.356 0.738 0.938

      ↑の一番左の数字67を取得できれば宜しいです。A,B,C・・・は項目名になります。
      宜しくお願い致します。




    [195205] Re[9]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マナ -(2022/09/02(20:32))
    □U R L/
      まずは
      
      >ReDim BaseNames(FSO.GetFolder(File_Path).Files.Count)
      
      ループの中にあって大丈夫ですか?
      
      


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

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




    [195206] Re[10]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マナ -(2022/09/02(20:36))
    □U R L/

      テキストファイルの最終行を取得する
      ht tp://officetanaka.net/excel/vba/tips/tips121.htm




    [195214] Re[11]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マナ -(2022/09/05(20:05))
    □U R L/
      >ループの中にあって大丈夫ですか?
      
      ループの外に出すか、中で使うときは、ReDim Preserve とするとよいです。
      また、1回のループで、名前と最終行の値を配列に入れていくとよいです。
      
      Sub test()
          Dim ws As Worksheet
          Dim fdg As FileDialog, p As String
          Dim fso As Object, f As Object
          Dim ts As Object, csv As String, s
          Dim v(), n As Long
          
          Set ws = ActiveSheet
          
          Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
          If Not fdg.Show Then Exit Sub
          p = fdg.SelectedItems(1)
          
          Set fso = CreateObject("scripting.filesystemobject")
          
          For Each f In fso.getfolder(p).Files
              If LCase(f.Name) Like "*.csv" Then
                  n = n + 1
                  ReDim Preserve v(1 To 2, 1 To n)
                  v(1, n) = f.Name
                  Set ts = f.openastextstream
                  csv = ts.readall
                  ts.Close
                  s = Split(csv, vbCrLf)
                  v(2, n) = Split(s(UBound(s) - 1), ",")(0)
              End If
          Next
                  
          ws.UsedRange.Offset(1).ClearContents
          ws.Range("a2").Resize(n, 2).Value = Application.Transpose(v)
          
      End Sub


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

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




    [195216] Re[12]: 指定フォルダからの値を抽出・貼付け-

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

    □投稿者/ マナ -(2022/09/06(22:16))
    □U R L/
      ループの外に出す例
      想定される最大のサイズを確保しておく。
      わたしの場合は、こっちの使い方が多い。
      
      Sub test2()
          Dim ws As Worksheet
          Dim fdg As FileDialog, p As String
          Dim fso As Object, ff As Object, f As Object
          Dim ts As Object, csv As String, s
          Dim v(), n As Long
          
          Set ws = ActiveSheet
          
          Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
          If Not fdg.Show Then Exit Sub
          p = fdg.SelectedItems(1)
          
          Set fso = CreateObject("scripting.filesystemobject")
          Set ff = fso.getfolder(p).Files
          ReDim v(1 To ff.Count, 1 To 2)
          
          For Each f In ff
              If LCase(f.Name) Like "*.csv" Then
                  n = n + 1
                  v(n, 1) = f.Name
                  Set ts = f.openastextstream
                  csv = ts.readall
                  ts.Close
                  s = Split(csv, vbCrLf)
                  v(n, 2) = Split(s(UBound(s) - 1), ",")(0)
              End If
          Next
                  
          ws.UsedRange.Offset(1).ClearContents
          ws.Range("a2").Resize(n, 2).Value = v
          
      End Sub
      
      


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

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




    [195217] Re[13]: 指定フォルダからの値を抽出・貼付け-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ おりふぃす -(2022/09/06(23:36))
    □U R L/

      無事に解決することが出来ました。
      色々為になる構文を教えて頂き、大変分かりやすかったです。
      もう少し勉強したいです。
      誠にありがとうございました。



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

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

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


- Child Forum -
Edit:ゆう-G