テキストデータからシートに特定のデータを抽出したいです。

Question

初心者で説明不足で申し訳ありません。

前提・実現したいこと

複数のテキストデータをダイアログで選択してExcelシートに読み込ませたいです。
1つの時もあれば4つの時もありフォルダも別で固まっているのでダイアログで
選択する方式が合っていると思いました。

テキストの.txtより右にあるテキスト名とデータ内のF2から下の空白になるまでを
ExcelのG10にはテキスト名
G11から下にはテキストデータ内のF2から空白になるまでのデータを読み込ませたいです。
2つ目以降のデータは
H10にテキスト名
H11から下にはテキストデータ内の・・　というように右にスライドしていってほしいです。

テキストデータは複数選択できるのを希望しています。
読み込む順番は規則性はなくてもいいです。

手作業でテキストデータを開いて貼り付けて名前を10行目に入力して…
というのをマクロで効率化できないかと考えております。
↓

     …  F           G            H             I

9
10 samA samC samD
11 2.3 3.5 2.1
12 4.4 5.3 3.3
13 2.4 4.6 5.6

発生している問題・エラーメッセージ

現状は全て手作業で行っており

・Excelシートを開く
・テキストデータをカーソルをもってきて開く
・データ内のF2から下の空白までをコピーしてシートのG11に貼り付ける
・シートのG10にテキスト名を手打ち。
・閉じて次のテキストに移る
・次のテキストを開く
・データ内のF2から下の空白までをコピーしてシートのH11に貼り付ける
・シートのH10にテキスト名を手打ち
という内容になります。

該当のソースコード

すみませんありません。

試したこと

サイトを検索して探していましたが
下記の様に複数選択で読み込むところからやっていこうとしましたが
何もできずに挫折しました。

OpenFileNames = Application.GetOpenFilename("テキストデータ,*.txt", MultiSelect:=True)
If IsArray(OpenFileNames) Then
For Each f In OpenFileNames

すみませんが御教授頂よろしくお願いします。

Comments

[dodox86]

> 下記の様に複数選択で読み込むところからやっていこうとしましたが
> 何もできずに挫折しました。

現在手作業でやっていることをプログラムで自動化したい、という動機は大変すばらしいことですが、初心の方としては進め方に問題があります。
何もできない状態から全てやろうとするから挫折します。複数選択するところからではなく、まず1つだけのファイルから進めましょう。
1つだけのファイルを選択することすら難しいのであれば、ファイル名は固定にして、ファイルを開き、指定のセル範囲に張り付けることから始めてください。それも難しかったらもう少し分解します。単に文字列をセルに張り付けることから、とか。
現状、何もできずに挫折したというのであれば回答は1から10まで教えることになるので、敬遠もされるし低評価につながります。
「ひとつのファイルならプログラムを作れたが、複数のファイルを扱うにはどうしたら良いか分からない。」程度になれば、アドバイス（含む回答）もしやすくなります。

[meg_]

ファイル選択処理についてはひとまず置いておいて、データ処理の方からコーディングされてはどうでしょうか？

Answer 1

こんにちはこんばんは、よろしくおねがいいたします。
まず、”テキストデータ”と書いておられますが、”手作業”のところを読むとどうやらエクセルファイルのようなので、そのように理解しました。

で、こういうのはどうでしょうか？

Option Explicit

Sub test()

Dim FileNameList As Variant
Dim i As Long
Dim SourceFileName As String

Dim TenkiMotoBook As Workbook
Dim TenkiMotoFileName As String
Dim TenkiMotoSheet As Worksheet
Dim TenkisakiSheet As Worksheet

Dim TenkiMotoRange As Range
Set TenkisakiSheet = ThisWorkbook.Worksheets("sheet1")

Dim r As Long, c As Long
r = 10 : c = 7  'G10セルのことです
    
FileNameList = Application.GetOpenFilename("Microsote Excelブック, *.xlsx", MultiSelect:=True)

    If Not IsArray(FileNameList) Then   'キャンセルボタンが押されたとき、終了する
        Exit Sub
    End If
    
    For i = 1 To UBound(FileNameList)   'ダイアログで選択した数だけループする
    
        SourceFileName = FileNameList(i)
        Workbooks.Open SourceFileName   'ファイルを開く
        Set TenkiMotoBook = ActiveWorkbook
        Set TenkiMotoSheet = ActiveWorkbook.Worksheets("sheet1")
        
        TenkiMotoFileName = Dir(SourceFileName) 'フルパスのファイル名から、ファイル名だけを抽出する
        '転記元のファイル名を、１０行目の部分にセットする
        TenkisakiSheet.Cells(r, c) = TenkiMotoFileName
        
        TenkiMotoSheet.Select
        'F2セルから下へ、データのある範囲をコピーし、転記先シートへペーストする
        TenkiMotoSheet.Range("F2", Range("F2").End(xlDown)).Copy TenkisakiSheet.Cells(r + 1, c)
        '転記元のブックを閉じる
        TenkiMotoBook.Close
        
        c = c + 1   '右の列へシフトする
        
    Next i
        
End Sub

当方でテストしてみました。これで動作します。お試しください。