CSVを文字列で読み込み

Option Explicit
Option Base 1 ' 配列のインデックスを1から開始

Sub prcImportCSV_WithRange()
    Dim strFilePath As String   ' CSVファイルのパス
    Dim strLine As String       ' 1行分のデータ
    Dim arrData As Variant      ' 読み込んだデータを格納する配列
    Dim ws As Worksheet         ' データを貼り付けるワークシート
    Dim intFile As Integer      ' ファイル番号(Open文で使用)
    Dim arrTemp() As String     ' 1行分のデータをカンマで分割した配列
    Dim i As Long, j As Long    ' ループ用変数
    
    ' === 読み込む範囲を指定 ===
    Dim lngColStart As Long: lngColStart = 6   ' CSV上の開始列
    Dim lngColLast As Long: lngColLast = 10    ' CSV上の最終列
    Dim lngRowStart As Long: lngRowStart = 3   ' CSV上の開始行
    Dim lngRowLast As Long: lngRowLast = 7     ' CSV上の最終行
    
    ' CSVファイルのパスを指定
    strFilePath = "C:\Users\YourName\Desktop\sample.csv"
    
    ' 出力先シートを「test」に変更
    Set ws = ThisWorkbook.Sheets("test")
    
    ' 出力範囲の行数・列数を決定
    Dim outputRows As Long: outputRows = lngRowLast - lngRowStart + 1
    Dim outputCols As Long: outputCols = lngColLast - lngColStart + 1
    
    ' 配列のサイズを決定(1ベースで確保)
    ReDim arrData(1 To outputRows, 1 To outputCols)
    
    ' CSVファイルを開く
    intFile = FreeFile() ' 使用可能なファイル番号を取得
    Open strFilePath For Input As #intFile
    
    ' === 指定開始行までスキップ ===
    Dim skipRow As Long
    For skipRow = 1 To lngRowStart - 1
        Line Input #intFile, strLine ' 指定行までスキップ
    Next skipRow

    ' === 指定範囲内のデータを処理 ===
    For i = 1 To outputRows
        ' 最終行を超えた場合はループを抜ける
        If EOF(intFile) Then Exit For
        
        Line Input #intFile, strLine ' 1行ずつ読み込み
        arrTemp = Split(strLine, ",") ' カンマで分割
        
        ' 指定列内でデータを格納
        For j = 1 To outputCols
            ' データがある場合のみ取得
            If lngColStart - 1 + j <= UBound(arrTemp) Then
                arrData(i, j) = "'" & arrTemp(lngColStart - 1 + j) ' 文字列として扱う
            Else
                arrData(i, j) = "" ' データがない場合は空欄
            End If
        Next j
    Next i
    
    ' ファイルを閉じる
    Close #intFile
    
    ' === Excelに一括書き込み(出力開始位置を A1 に固定) ===
    ws.Range("A1").Resize(outputRows, outputCols).Value = arrData
    
    ' 書式設定(貼り付け範囲を文字列に)
    ws.Range("A1").Resize(outputRows, outputCols).NumberFormat = "@"

    ' 後処理
    Set ws = Nothing
End Sub

コメント