マクロの乗ったExcelファイルと同じディレクトリにあるcsvファイルを全て読み込むやつ

• 背景
• 概要
• ReadCSV
• DeleteCSV
• Reference

背景

Qiita初投稿です。

ラボで使っている装置が、測定データ(Current-Voltage特性など)を.csvで吐き出します。基本的に1条件あたり1csvとなるので、いろんな条件で測るとデータ整理が大変。

ということで、xlsmファイルと同じディレクトリにあるcsvファイルを全て読み込むマクロを書きました。

概要

読み込まれたcsvは「Data1」「Data2」...という名前のシートとして、マクロの乗ったWorkbookに保存されていきます。

自分用で、「動けばいいや」なのでコード汚いです。ごめんよ。

ReadCSV

Sub readCSV()

    Dim fso As Object
    Dim csvFile As Object
    Dim csvData As String
    Dim splitcsvData As Variant
    Dim i, j, cnt As Integer
    Dim buf As String
    Dim path As String

    buf = Dir(ThisWorkbook.path & "\*.csv")

    ' CSVファイルが見つからないときの処理
    If buf = "" Then
        MsgBox "There are NO csv files"
        End
    End If

    cnt = 1
    Do While buf <> ""
        Set fso = CreateObject("Scripting.FileSystemObject")
        path = ThisWorkbook.path
        Set csvFile = fso.OpenTextFile(path & "\" & buf, 1)

        i = 1
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = "Data" & cnt

        Do While csvFile.AtEndOfStream = False
            csvData = csvFile.ReadLine
            splitcsvData = Split(csvData, ",")
            j = UBound(splitcsvData) + 1
            ActiveSheet.Range(Cells(i, 1), Cells(i, j)).Value = splitcsvData

            i = i + 1
        Loop

        cnt = cnt + 1    
        csvFile.Close        
        Set csvFile = Nothing
        Set fso = Nothing 

        '一番左上のセルにcsvファイルの名前を出力します。
        Cells(1, 1) = buf
        buf = Dir()

    Loop

    MsgBox ("Complete")

End Sub

DeleteCSV

大量のcsvを読み込むとシートの数が爆発するので、一撃で削除するマクロも書きました。

Sub deleteCSV()
    ' 先頭のシートを除く、全てのシートを削除します
    Do While Sheets.Count > 1
        Application.DisplayAlerts = False
        Sheets(2).Delete
        Application.DisplayAlerts = True
    Loop
End Sub

Reference

Qiita記事の書き方
Qiita記事作成方法 初心者の備忘録

Qiitaのシンタックスハイライト
Qiitaでシンタックスハイライト可能な言語一覧

VBAのもろもろ
Office TANAKA Excel VBAコンテンツ