4
8

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

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

Last updated at Posted at 2019-04-16

やりたいこと

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で文字コードを指定。headerFalseにすると先頭にヘッダ行が追加される。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を新規シートに貼り付けている。ちなみに遅い。

4
8
1

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
4
8

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?