Qiita創業者海野氏登壇！Qiita エンジニアフェスタ 2021 Online Meetupを9/9(木)に開催詳しくはこちら
2
6

この記事は最終更新日から1年以上が経過しています。

@nkay

VBAでCSVファイルをExcelワークシートに開く

VBACSVExcelVBA

やりたいこと

VBAでCSVファイルをエクセルのシートに貼り付けたい。

方法

調べたらたくさんあった。

Open

Dim r As Long, c As Long
Dim strrow As String
Dim varrow As Variant

Open "D:/data/file.csv" For Input As #1
    r = 0
    Do Until EOF(1)
        r = r + 1
        Line Input #1, strrow
        varrow = Split(strrow, ",")
        ' 書き込み
        c = UBound(varrow)
        ActiveSheet.Range(Cells(r, 1), Cells(r, c + 1)).Value = varrow
    Loop
Close #1

一行ずつ読み込んで貼っていくスタイル。

これで読み込んだところ、整数型の要素もすべて文字型として貼り付けられてしまったため、シートが緑三角の洪水に襲われた。
「書き込み」の部分を以下のように修正し、1要素ずつ貼り付けるようにしたらうまくいった。

        ' 書き込み
        For c = 0 To Ubound(varrow)
            ActiveSheet.Cells(r, c + 1).Value = varrow(c)
        Next c

欠点

  • カンマが入った要素が区切られてしまう
  • ShiftJIS以外のファイルがうまく読めない
  • なんか遅い（一行ずつ貼ってるからか）

fso.OpenTextFile

Dim FSO As Object
Dim r As Long, c As Long
Dim strrow As String
Dim varrow As Variant

Set FSO = CreateObject("Scripting.FileSystemObject")
With FSO.OpenTextFile("D:/data/file.csv")
    r = 0
    Do While .AtEndOfStream = False
        r = r + 1
        strrow = .ReadLine
        varrow = Split(strrow, ",")
        ' 書き込み
        c = UBound(varrow)
        ActiveSheet.Range(Cells(r, 1), Cells(r, c + 1)).Value = varrow
    Loop
End With
Set FSO = Nothing

Openとなにが違うのか？
こいつは頑張ればUTF-8でも読めるようにできるらしい。

Workbooks.Open

Workbooks.Open "D:/data/file.csv"

コードが短い。簡単。
UTF-8で書かれたファイルを読み込むときはOrigin:=65001をつける。

Workbooks.OpenText

Workbooks.OpenText "D:/data/file.csv", Comma:=True

Workbooks.Openの厳密版（？）。CSVファイルはあくまでテキストファイルなのでテキストを読み込むつもりの方が良いということか。

特徴

  • 新しいブックで開く（利点かもしれないし欠点かもしれない）
  • ファイル名がそのままシート名になる（便利）
  • 戻り値がない（どうでもいいようなよくないような）

新しいブックで開きたくないときは、例えば以下のように、生みだされたブックからシートを移動する。

Workbooks.OpenText "D:/data/file.csv", Comma:=True
ActiveWorkbook.Sheets.Move , ThisWorkbook.Sheets(1)

QueryTables.Add

With ActiveSheet.QueryTables.Add("TEXT;" & "D:/data/file.csv", _
                                 ActiveSheet.Range("A1"))
    .TextFileCommaDelimiter = True
    .Refresh
    .Delete
End With

くそはやい。読み込みオプションも多いしこれだわ。

コード

CSVを読んで新しいシートとして出現させる関数をつくってみた。そのシートが戻り値。
encodingで文字コードを指定。headerをFalseにすると先頭にヘッダ行が追加される。adjustは列幅を要素にあわせて変えるかどうか。
★2019/04/23：戻り値をListObject型にしました。

Function read_csv(ByVal filepath As String, _
                  Optional ByVal encoding As String = "utf_8", _
                  Optional ByVal header As Boolean = True, _
                  Optional ByVal adjust As Boolean = True) As ListObject
    Dim ws As Worksheet
    Dim origin As Long
    Dim i As Long

    If Dir(filepath) = "" Then
        MsgBox filepath & " は存在しません。", vbOKOnly + vbCritical
        Exit Function
    End If

    Select Case encoding
        Case "shift_jis", "csshiftjis", "shiftjis", "sjis", "s_jis"
            origin = 932
        Case "big5", "big5-tw", "csbig5"
            origin = 950
        Case "utf_16", "U16", "utf16"
            origin = 1200
        Case "utf_8", "U8", "UTF", "utf8"
            origin = 65001
    End Select

    Set ws = Worksheets.Add
    With ws
        With .QueryTables.Add("TEXT;" & filepath, .Range("A1"))
            .TextFilePlatform = origin
            .TextFileCommaDelimiter = True
            .AdjustColumnWidth = adjust
            .Refresh
            .Delete
        End With

        If header = False Then
            .Rows(1).Insert
            For i = 1 To .Cells(2, Columns.Count).End(xlToLeft).Column
                .Cells(1, i).Value = i - 1
            Next i
        End If

        Set read_csv = .ListObjects.Add
    End With
End Function

こんなふうにつかう。

test.bas
Option Explicit

Public Sub test()
    Dim df As ListObject

    Set df = read_csv("D:/data/file.csv", adjust:=False)
    If df Is Nothing Then
        ' エラー時の処理
        Exit Sub
    End If

    ' 処理
End Sub

おまけのメモ

xlwings.RunPython

RunPython "import xlwings as xw ; import pandas as pd ; " & _
          "xw.sheets.add().range('A1').value = pd.read_csv('D:/data/file.csv')"

xlwingsを導入するとxlwings.RunPython()の中にPythonのコードが書けるという裏技。
pd.read_csv()で読んだcsvを新規シートに貼り付けている。ちなみに遅い。

ユーザー登録して、Qiitaをもっと便利に使ってみませんか。
  1. あなたにマッチした記事をお届けします
    ユーザーやタグをフォローすることで、あなたが興味を持つ技術分野の情報をまとめてキャッチアップできます
  2. 便利な情報をあとで効率的に読み返せます
    気に入った記事を「ストック」することで、あとからすぐに検索できます
nkay
使用言語：R（2018/5～2018/8）、ExcelVBA（2019/4～7）、Python（2018/9～）
この記事は以下の記事からリンクされています
nkayExcelVBAで積み上げ縦棒グラフを描くからリンク

コメント

Q11Q@Q11Q

Opentextも細かいオプションがあります。列ごとのデータ型も指定できます。また、返り値はありませんが、WorkBooksコレクションに追加されます。基本的にはカウントはThisworkbookより後ろなので、1つしか開いていないとすれば基本的には次のようにすると取得できます。欠点でもあり長所でもありますが、フィールド情報を１列づつ指定できるところです。またアクセスの限界である256列を超えます。でもフィールド情報が長いほどめんどくさいので、ある程度高い頻度で使うDBから出力したCSVのようなものにしか使えません。
このためお気付きの通りQueryTableを使う方法が良いのですが、この方法はフィールド情報が数字1個なので可読性がまったくないのが難点です。
Accessの方が和暦だとCSVは挙動がおかしくなるので、こうした場合は、一旦xlsxに保存する方法をとっています。これでもだめならPowershellで整形してからExcelに流し込みます。Excelで日付だと認識されれば、DBへの変換などスムーズになりますので、CSVをExcelに読み込ませるときはデータ型が認識されるのがExcelの最大の特徴だと思います。また、通貨に関しては通貨記号をつけると通貨型になります。しかしドルでも円になり、小数点が見た目なくなります。また、コンマ付き数字はその列のすべての数字がコンマ付きでかつダブルクォーテーションで包まれていると読み込まれます。OpenTextだとオプションがTextQualifierです。

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Dim wb1 As Workbook
ChDir "C:\hoge"
Workbooks.OpenText Filename:="C:\hoge\sample.csv", Origin:=932, DataType:=xlDelimited, startrow:=1, textqualifier:=xlTextQualifierDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar:="", FieldInfo:= _
    Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 5), Array(5, 5)), DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:=True, local:=True
Set wb1 = WorkBooks(WorkBooks.Count)
1
あなたもコメントしてみませんか :)
ユーザー登録
すでにアカウントを持っている方はログイン