やりたいこと
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
こんなふうにつかう。
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を新規シートに貼り付けている。ちなみに遅い。