ファイル読み込みVBA～tsvファイルを読み込む

プロンプト by わたし

以下の要件をVBAでコーディングしてください

[前提]
マクロファイルがあるフォルダ内にサブフォルダ「ひな形」があり、その中にひな形.xlsxが入っている

[要件]
・マクロファイルがあるフォルダ内にtsvファイルがあるとき、ひな形.xlsxから、拡張子を除いたファイル名と一致するシート名のシートを探し、マクロファイルにシートごとコピーする
・マクロファイルにコピーされたシートに、A4セルを起点にtsvファイルを読み込む。
・tsvファイルは、タブ区切りを1セルずつに分けて、全列を文字列として読み込む

generate by chatGPT

Sub ImportTSVData()
    Dim wbMacro As Workbook
    Dim wbTemplate As Workbook
    Dim tsvFile As String
    Dim folderPath As String
    Dim templatePath As String
    Dim sheetName As String
    Dim newSheet As Worksheet
    Dim dataRow As String
    Dim dataArray() As String
    Dim fileNum As Integer
    Dim line As String
    Dim i As Long
    Dim j As Long
    
    ' マクロファイルが存在するフォルダパス
    folderPath = ThisWorkbook.Path & "\"
    ' ひな形ファイルのパス
    templatePath = folderPath & "ひな形\ひな形.xlsx"
    ' マクロファイル
    Set wbMacro = ThisWorkbook
    
    ' フォルダ内のTSVファイルを取得
    tsvFile = Dir(folderPath & "*.tsv")
    
    Do While tsvFile <> ""
        ' TSVファイル名（拡張子を除く）
        sheetName = Left(tsvFile, InStrRev(tsvFile, ".") - 1)
        
        ' ひな形.xlsxを開く
        Set wbTemplate = Workbooks.Open(templatePath)
        
        ' シート名が一致するシートを探す
        On Error Resume Next
        Set newSheet = wbTemplate.Sheets(sheetName)
        On Error GoTo 0
        
        If Not newSheet Is Nothing Then
            ' マクロファイルにシートをコピー
            newSheet.Copy After:=wbMacro.Sheets(wbMacro.Sheets.Count)
            Set newSheet = wbMacro.Sheets(wbMacro.Sheets.Count)
            
            ' TSVデータを読み込む
            fileNum = FreeFile
            Open folderPath & tsvFile For Input As #fileNum
            
            i = 4 ' A4セルを起点にデータを配置
            Do Until EOF(fileNum)
                Line Input #fileNum, dataRow
                dataArray = Split(dataRow, vbTab)
                
                For j = LBound(dataArray) To UBound(dataArray)
                    ' 各セルに文字列として書き込む
                    newSheet.Cells(i, j + 1).Value = CStr(dataArray(j))
                Next j
                
                i = i + 1
            Loop
            Close #fileNum
        End If
        
        ' ひな形を閉じる
        wbTemplate.Close SaveChanges:=False
        
        ' 次のファイルへ
        tsvFile = Dir()
    Loop
End Sub

chatGPTからのコメント

1. マクロフォルダのパス: ThisWorkbook.Pathを使用して、マクロファイルがあるフォルダを取得しています。
2. ひな形のシートコピー: Workbook.Sheets(sheetName).Copyを使用して、シートをコピーしています。
3. TSVの読み込み:
   1. Open ... For Input As #fileNumでTSVファイルを開き、1行ずつ読み込みます。
   2. Split関数でタブ区切りのデータを配列に分解し、文字列としてセルに書き込んでいます。
4. エラー処理:
   1. On Error Resume Nextで、一時的にエラーを無視してシートの存在確認をしています。