CSVファイル読み込み(Excel)

CSVファイルを読み込むエクセルマクロのサンプルです。

マクロ

Option Explicit
Option Compare Text
'Result
Dim itemListStr() As String
Dim writeColPosIdxList() As Long
Dim itemListStrIdx As Long
'Input
Dim readFileItemListStr() As String
Dim readFileItemListStrIdx As Long
'Execute
Private Sub ReadCSV_Click()
    Dim wsResult As Worksheet
    Dim proccessCanceled As Boolean
    Dim writeSheetTitleRowPos As Long
    Dim writeSheetDataStartRowPos As Long
    Dim readFileDataStartRowPos As Long
    Dim outputItemListCount As Long
    Dim wkStr As String
    Dim itemStr As String
    Dim keyId As String
    
    Dim fileName As String
    Dim fileFullPathName As String
    Dim readRowPos As Integer
    Dim readFileItemCount As Integer
    Dim writeRowPos As Integer
    Dim writeColPos As Integer
    Dim idx As Integer
    Dim percent As Integer
    Dim count As Integer
    Dim statusBarDispItemPos As Integer
    
    proccessCanceled = False
    Set wsResult = Worksheets(1)
    writeSheetTitleRowPos = 1
    writeSheetDataStartRowPos = 2
    readFileDataStartRowPos = 2
    outputItemListCount = 20
    
    fileName = "issues.csv"
    fileFullPathName = ThisWorkbook.Path + "\" + fileName
    writeRowPos = writeSheetDataStartRowPos
    
    'output list
    For itemListStrIdx = 0 To outputItemListCount
        ReDim Preserve itemListStr(itemListStrIdx)
        ReDim Preserve writeColPosIdxList(itemListStrIdx)
        wkStr = Cells(writeSheetTitleRowPos, itemListStrIdx + 1).Value
        If wkStr <> "" Then
            itemListStr(itemListStrIdx) = wkStr
            writeColPosIdxList(itemListStrIdx) = 0
        Else
            Exit For
        End If
    Next itemListStrIdx
    
    'clear
    wsResult.Range(Cells(writeSheetDataStartRowPos, 1), Cells(1000, 100)).ClearContents
    If Dir(fileFullPathName) = "" Then
        MsgBox "ファイル(" + fileName + ")が存在しません。", vbExclamation
        Exit Sub
    End If
    count = 0
    readRowPos = 1
    readFileItemCount = 100
    statusBarDispItemPos = 2
    With Workbooks.Open(fileFullPathName, False, True)
        keyId = Sheets(1).Cells(readRowPos, 1)
    
        'input list
        For readFileItemListStrIdx = 0 To readFileItemCount
            ReDim Preserve readFileItemListStr(readFileItemListStrIdx)
            wkStr = Sheets(1).Cells(1, readFileItemListStrIdx + 1).Value
            If wkStr <> "" Then
                readFileItemListStr(readFileItemListStrIdx) = wkStr
                
                'Index Setting
                For itemListStrIdx = LBound(itemListStr) To UBound(itemListStr)
                   itemStr = Trim(itemListStr(itemListStrIdx))
                   If itemStr = wkStr Then
                      writeColPosIdxList(itemListStrIdx) = readFileItemListStrIdx + 1
                      Exit For
                   End If
                Next itemListStrIdx
            Else
                Exit For
            End If
        Next readFileItemListStrIdx
    
        readRowPos = readFileDataStartRowPos
        keyId = Sheets(1).Cells(readRowPos, 1)
    
        Do While Trim(keyId) <> ""
            count = count + 1
            readRowPos = readRowPos + 1
            keyId = Sheets(1).Cells(readRowPos, 1)
        Loop
    
        'Display Form
        UserForm1.Show vbModeless
        Application.Cursor = xlWait
    
        readRowPos = readFileDataStartRowPos
        
        'Readind data...
        For idx = 1 To count
            'Cancel check
            If UserForm1.IsCancel = True Then
                proccessCanceled = True
                Unload UserForm1
                Application.Cursor = xlDefault
                MsgBox "処理を中断しました。"
                Exit For
            End If
            
            writeColPos = 1
        
            percent = CInt(idx / count * 100)
            UserForm1.Label1.Caption = "処理中です。(" & percent & "%)"
            DoEvents
            Application.StatusBar = "(" & idx & "/" & count & ")" & _
                  String(Int(idx / count * 10), "■") + "[" & _
                  Sheets(1).Cells(readRowPos, statusBarDispItemPos).Value & "]を処理中…"
        
            'Output
            For itemListStrIdx = LBound(itemListStr) To UBound(itemListStr)
                itemStr = Trim(itemListStr(itemListStrIdx))
                If (writeColPosIdxList(itemListStrIdx) > 0) Then
                    wsResult.Cells(writeRowPos, writeColPos) = Sheets(1).Cells(readRowPos, writeColPosIdxList(itemListStrIdx)).Value
                End If
                writeColPos = writeColPos + 1
            Next itemListStrIdx
            readRowPos = readRowPos + 1
            writeRowPos = writeRowPos + 1
            keyId = Sheets(1).Cells(readRowPos, 1)
        Next
        Unload UserForm1
        Application.Cursor = xlDefault
        
        .Close SaveChanges:=False
    End With
    Application.StatusBar = False
    If proccessCanceled <> True Then
        MsgBox "処理完了"
    End If
End Sub

Excelフォーマット

読込CSVファイル