| |
Yukiさんありがとうございます。
正常に動作致しました。改行されていなかったのが原因だったようです。
１行目の項目だけが入力してある状態で実行していた為実行できなかった
ようです。テストデータまで公開して頂き感謝致します。まさにこの様な
動作を期待していました。本当にありがとうございました＾−＾
▼Yuki さん：
>▼アヒルペンギン さん：
>貴方のデータが分からないのでチョット分かりません。
>テストに使用したデータ作成は
>
>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
>
> '本処理 ２行目以降の処理
> 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
|
|
アヒルペンギン
- 08/6/17(火) 16:28 -
