|
|
|
|
コメント(15)
ミスキタさん、
＞いったんファイルに書き出し
とあるので、ファイルでないCSVデータがどんなものか想像できないので私の状況をお話しします。
私の場合、
月一でCSVデータファイルをもらい、自分のEXCELに取り込むことをしています。
自分のEXCELのVBAで別のEXCELのBookとしてCSVファイルを読み込みます。
別Bookで立ち上げてしまえば、単なるEXCELのシートとしてあつかえます。
２つのBookのデータをVBAで処理します。
利用後のCSVのBookはSaveせずに閉じる方式を取っています。
CSVファイルはまったく元のまま状態で残ります。
なお、
CSVファイルをEXCELとして起動する時間は気になりません（単なる私の感覚ですが）
参考になりませんかね。
＞いったんファイルに書き出し
とあるので、ファイルでないCSVデータがどんなものか想像できないので私の状況をお話しします。
私の場合、
月一でCSVデータファイルをもらい、自分のEXCELに取り込むことをしています。
自分のEXCELのVBAで別のEXCELのBookとしてCSVファイルを読み込みます。
別Bookで立ち上げてしまえば、単なるEXCELのシートとしてあつかえます。
２つのBookのデータをVBAで処理します。
利用後のCSVのBookはSaveせずに閉じる方式を取っています。
CSVファイルはまったく元のまま状態で残ります。
なお、
CSVファイルをEXCELとして起動する時間は気になりません（単なる私の感覚ですが）
参考になりませんかね。
今、使っている方法です。
A1にあるテキストデータ（CSV）を分解して、
3行目に張り付けています。
A1 = ,a,"b,c","d,""e""","""f"""
として実行していただくとわかりやすいと思います。
実行には参照設定で Microsoft ActiveX Data Objects 2.* Library にチェックを入れておく必要があります。
---
Option Explicit
Sub CSV読み込み()
Dim buf As String
Dim CSVFile As String
Dim tmpCSV As String
Dim cnn As New ADODB.Connection
Dim res As New ADODB.Recordset
buf = Range("A1")
' CSV読み込みのための一時ファイル名
CSVFile = "csvdata.tmp"
tmpCSV = ThisWorkbook.Path & "\" & CSVFile
Open tmpCSV For Output As #1
Print #1, buf
Close #1
' CSVファイルに接続
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Text; IMEX=1; HDR=NO"
.Open ThisWorkbook.Path
End With
' CSVファイル読み込み
Set res = cnn.Execute("SELECT * FROM " & CSVFile)
' 読み込んだデータをシートに張り付け
Range("A3").CopyFromRecordset res
' 接続終了
cnn.Close
' 一時ファイルを削除
Kill tmpCSV
End Sub
A1にあるテキストデータ（CSV）を分解して、
3行目に張り付けています。
A1 = ,a,"b,c","d,""e""","""f"""
として実行していただくとわかりやすいと思います。
実行には参照設定で Microsoft ActiveX Data Objects 2.* Library にチェックを入れておく必要があります。
---
Option Explicit
Sub CSV読み込み()
Dim buf As String
Dim CSVFile As String
Dim tmpCSV As String
Dim cnn As New ADODB.Connection
Dim res As New ADODB.Recordset
buf = Range("A1")
' CSV読み込みのための一時ファイル名
CSVFile = "csvdata.tmp"
tmpCSV = ThisWorkbook.Path & "\" & CSVFile
Open tmpCSV For Output As #1
Print #1, buf
Close #1
' CSVファイルに接続
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Text; IMEX=1; HDR=NO"
.Open ThisWorkbook.Path
End With
' CSVファイル読み込み
Set res = cnn.Execute("SELECT * FROM " & CSVFile)
' 読み込んだデータをシートに張り付け
Range("A3").CopyFromRecordset res
' 接続終了
cnn.Close
' 一時ファイルを削除
Kill tmpCSV
End Sub
できました。
CsvToArray がCSVデータを配列に読み込む関数です。
メインルーチンの Data = CsvToArray(buf) で、
buf に入っているCSVデータ（テキストデータ）を配列（Data)に読み込みます。
高速にCSVデータを読み込むことができますので、よろしければご活用ください。
テストする場合は、
ブックと同じ場所に data.csv というCSVファイルを用意して実行すると、
アクティブシートに data.csv の内容が読み込まれます。
修正点などお気づきのことがあればお知らせ願えれば幸いです。
' ---
Option Explicit
Sub CSV読み込み()
Dim buf As String
Dim Data()
Range("A1").CurrentRegion.ClearContents
With CreateObject("Scripting.FileSystemObject")
With .getfile(ThisWorkbook.Path & "\data.csv").openastextstream
buf = .readall
.Close
End With
End With
Data = CsvToArray(buf)
Range(Cells(1, 1), Cells(UBound(Data, 1) + 1, UBound(Data, 2) + 1)) = Data
End Sub
' ---
Public Function CsvToArray(Text)
Dim RE As Object
Dim Lines() As String
Dim Values() As String
Dim Data() As Variant
Dim i As Long, j As Long
Set RE = CreateObject("VBScript.RegExp")
RE.Global = True
RE.ignorecase = False
RE.pattern = "\s*,\s*(?=(?:[^""]*""[^""]*"")*[^""]*$)"
Lines = Strings.Split(Text, vbCrLf)
Values = Strings.Split(RE.Replace(Lines(0), vbNullChar), vbNullChar)
ReDim Data(UBound(Lines), UBound(Values))
For i = 0 To UBound(Lines)
Values = Strings.Split(RE.Replace(Lines(i), vbNullChar), vbNullChar)
For j = 0 To UBound(Values)
If Left(Values(j), 1) = """" Then
Values(j) = Mid(Values(j), 2, Len(Values(j)) - 2)
Values(j) = Replace(Values(j), """""", """")
End If
Data(i, j) = Values(j)
Next
Next
Set RE = Nothing
CsvToArray = Data
End Function
' ---
CsvToArray がCSVデータを配列に読み込む関数です。
メインルーチンの Data = CsvToArray(buf) で、
buf に入っているCSVデータ（テキストデータ）を配列（Data)に読み込みます。
高速にCSVデータを読み込むことができますので、よろしければご活用ください。
テストする場合は、
ブックと同じ場所に data.csv というCSVファイルを用意して実行すると、
アクティブシートに data.csv の内容が読み込まれます。
修正点などお気づきのことがあればお知らせ願えれば幸いです。
' ---
Option Explicit
Sub CSV読み込み()
Dim buf As String
Dim Data()
Range("A1").CurrentRegion.ClearContents
With CreateObject("Scripting.FileSystemObject")
With .getfile(ThisWorkbook.Path & "\data.csv").openastextstream
buf = .readall
.Close
End With
End With
Data = CsvToArray(buf)
Range(Cells(1, 1), Cells(UBound(Data, 1) + 1, UBound(Data, 2) + 1)) = Data
End Sub
' ---
Public Function CsvToArray(Text)
Dim RE As Object
Dim Lines() As String
Dim Values() As String
Dim Data() As Variant
Dim i As Long, j As Long
Set RE = CreateObject("VBScript.RegExp")
RE.Global = True
RE.ignorecase = False
RE.pattern = "\s*,\s*(?=(?:[^""]*""[^""]*"")*[^""]*$)"
Lines = Strings.Split(Text, vbCrLf)
Values = Strings.Split(RE.Replace(Lines(0), vbNullChar), vbNullChar)
ReDim Data(UBound(Lines), UBound(Values))
For i = 0 To UBound(Lines)
Values = Strings.Split(RE.Replace(Lines(i), vbNullChar), vbNullChar)
For j = 0 To UBound(Values)
If Left(Values(j), 1) = """" Then
Values(j) = Mid(Values(j), 2, Len(Values(j)) - 2)
Values(j) = Replace(Values(j), """""", """")
End If
Data(i, j) = Values(j)
Next
Next
Set RE = Nothing
CsvToArray = Data
End Function
' ---
- mixiユーザー
- ログインしてコメントしよう！
|
|
|
|
Excel（エクセル）活用 更新情報
Excel（エクセル）活用のメンバーはこんなコミュニティにも参加しています
人気コミュニティランキング
- 1位
- パニック障害とうつ病
- 8435人
- 2位
- 音楽が無いと生きていけない
- 196000人
- 3位
- マイミク募集はここで。
- 89505人