| |
▼アヒルペンギン さん：
>Excelだと、横方向にはFFまでしか項目を読む事ができないようですが今回取り扱っているCSVは横方向に2000以上項目があります。シートを分割してもかまわないのでどうにかExcelで読み込む必要があるのですが、VBAでそういった処理をする事が可能でしょうか？先人の方々教えていただけると幸いです。
XL2007だったら一つのシートでいけますね。
数万行のデータだったらすごく時間がかかりそうです。
Sub TEXT_CSV2K_READ()
Dim FSO As Object ' File System Obj
Dim FsoTS As Object ' FSO.TextStream Obj
Dim File As Object ' FSO.file Obj
Dim strFN As String ' File Name
Dim eLN As Long ' CSVファイルの行数
Dim CLM As Long ' シート数
Dim strD As String ' 一行データ
Dim vD As Variant ' 一行分配列
Dim vA() As Variant ' シート用配列
Dim vX() As Variant ' セル用
Dim i As Long
Dim j As Long
strFN = "D:\Excel\Test.csv"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FsoTS = FSO.OpenTextFile(strFN, 8)
eLN = FsoTS.Line - 1
FsoTS.Close
Set File = FSO.GetFile(strFN)
Set FsoTS = File.OpenAsTextStream(1)
' 前処理
strD = FsoTS.ReadLine
vD = Split(strD, ",")
If UBound(vD) > 255 Then
CLM = Int(UBound(vD) / 256) + 1
Else
CLM = 1
End If
' シート不足分追加
If Worksheets.Count < CLM Then
Worksheets.Add Count:=CLM - Worksheets.Count
End If
ReDim vX(1 To CLM)
ReDim vA(1 To eLN, UBound(vD) - 1)
For i = 1 To CLM
vX(i) = vA
Next
j = 1
For i = 0 To UBound(vD)
vX(Int(i / 256) + 1)(j, i Mod 256) = vD(i)
Next
'本処理
Do While Not FsoTS.AtEndOfStream
DoEvents
strD = FsoTS.ReadLine
vD = Split(strD, ",")
j = j + 1
For i = 0 To UBound(vD)
vX(Int(i / 256) + 1)(j, i Mod 256) = vD(i)
Next
Loop
' シートに貼り付け
For i = 1 To CLM
DoEvents
With Worksheets(i)
.Cells.ClearContents
.Range("A1").Resize(j, 256).Value = vX(i)
End With
Next
FsoTS.Close
Set FsoTS = Nothing
Set FSO = Nothing
End Sub
|
|
Yuki
- 08/6/17(火) 10:58 -
