|
▼アヒルペンギン さん:
貴方のデータが分からないのでチョット分かりません。
テストに使用したデータ作成は
Sub CSVWrite()
Dim strD As String
Dim i As Long
Dim j As Long
Dim intF As Integer
intF = FreeFile
Open "D:\Excel\Test.csv" For Output As #intF
For j = 1 To 20
DoEvents
For i = 1 To 2000
strD = strD & Chr(64 + j) & Format(Hex(i), "00000") & ","
Next
strD = Left(strD, Len(strD) - 1)
Print #intF, strD
strD = ""
Next
Close #intF
End Sub
シート分割
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, ",")
' 配列数を256で割ってシート数を計算
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)
’訂正してください ↓
ReDim vA(1 To eLN, 255)
' シートの中にセルの配列を組み込む
For i = 1 To CLM
vX(i) = vA
Next
’一行目のデータをセット
’こちらではエラーにならないのですが
' 貴方のデータがどのようなものか分かりませんので
' 下記の説明でデバッグしてみて下さい。
j = 1
For i = 0 To UBound(vD)
Debug.Print i ' を追加してエラー時にチェック
’vX(Int(i / 256) + 1)はvX(1)です。
'(j, i Mod 256)は(1, i Mod 256)のはずです。
vX(Int(i / 256) + 1)(j, i Mod 256) = vD(i)
Next
'本処理 2行目以降の処理
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
|
|