| |
こんばんは。
テキストファイルの順次読込みは
やっぱり Line inputが速いと思いますけどねえ・・・
全角文字が入っていても対応できるようにしました。
'=============================================================
Sub main()
Dim mnum As Variant
Dim dat As String
Dim idx As Long, jdx As Long
mnum = Array(2, 3, 2, 2)
' A1BB1C1D1 −−−−−＞A1,BB1,C1,D1
' とする場合は、mnum = Array(2, 3, 2, 2) と指定します
' 尚、単位は、バイトです
ReDim csv(1 To UBound(mnum) + 1)
Open ThisWorkbook.Path & "\test.txt" For Input As #1
Open ThisWorkbook.Path & "\test.csv" For Output As #2
' ここは本来のファイル名を指定して下さい
Do Until EOF(1)
Line Input #1, dat
dat = StrConv(dat, vbFromUnicode)
idx = 0
jdx = 1
Do While idx <= UBound(mnum)
csv(idx + 1) = StrConv(MidB(dat, jdx, mnum(idx)), vbUnicode)
jdx = jdx + mnum(idx)
idx = idx + 1
Loop
MsgBox Join(csv(), ",")
Print #2, Join(csv(), ",")
Loop
Close #1, #2
End Sub
試してみて下さい。
ハトさん、こんばんは。
質問（初心者Ａ氏）さんは、ユーザー定義型を使用したいみたいなので
>
>Type T_DATA
> f1 As String * 10 ’バイト単位での処理のため
> f2 As String * 10 ’日本語（全角文字）の場合は文字数の２倍にする
> f3 As String * 10
> f4 As String * 10
> DMY As String * 2 ’←改行文字がある場合に必要
>End Type
>
>Sub RD_TXT()
>
>Dim RData As T_DATA
>Dim FName
>Dim i As Long
>
> i = 0
>' FName = "C:\xxxxxx\xxxx\xxxx.txt"
> 'ファイル選択ダイアログを開きファイル名を取得
> FName = Application.GetOpenFilename("ファイル (*.*),*.*")
>
> 'キャンセルを選択？
> If FName = False Then Exit Sub
>
> 'ファイルオープン
> Open FName For Binary As #1
>
> Get #1, , RData
> Do While Not EOF(1)
'これだと仮に一行のみのファイルだと何も処理しないで終わってしまいますよ！！
> i = i + 1
> With ThisWorkbook.Worksheets("Sheet4")
> .Cells(i, 1) = RData.f1
> .Cells(i, 2) = RData.f2
> .Cells(i, 3) = RData.f3
> .Cells(i, 4) = RData.f4
> End With
>' Get #1, , BRec
> Get #1, , RData
> Loop
>
> Close #1
>
>End Sub
気になったので投稿しました。
修正はおまかせします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
