Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


28006 / 76732 ←次へ | 前へ→

【54039】Re:while分を使用した場合の最終行の処理について
発言  ichinose  - 08/2/20(水) 22:21 -

引用なし
パスワード
   ▼さや さん:
こんばんは。


>テキスト(input)を読み込み80行で改行するしてテキスト(out.txt)出力する
>VBAをEXCELで作成しました。
>
>しかし、out.txtでは、80行づつ改行されるのですが、
>80行、160行、240行のデータをインポートする場合は
>最終行に80行の半角スペースが入ったデータが出力されます。
>きっとEOFを読み込んでいるため処理が動いて出力されているものと思われます。

というか80Byteとか160Byteの固定長で読み込んでいるからですよ!!

こういうのは、Binaryモードで残りのファイル容量を計算しながら
読み込むのだと思いますよ!!


新規ブックにて、
標準モジュールに

Sub Mk_Testdata()
  Dim idx As Long
  Dim mystr As String * 80
  On Error Resume Next
  Kill ThisWorkbook.Path & "\sample.dat"
  On Error GoTo 0
  Open ThisWorkbook.Path & "\sample.dat" For Binary As #1
  For idx = 0 To 10
    mystr = String(80, Chr(&H41 + idx))
    Put #1, , mystr
    Next
  Close #1
End Sub

以下のコードでサンプルファイルを作成します。
バイナリエディタなどで中身を確認してください
(AからKの文字を80字連続した内容です)
AAAAAAAAAA・・・BBBBBBBBB・・・・CCCCCCCCC・・・KKKKK・・・

以下のコードで160BYTE区切りで改行したファイルを作成します。

以前に作成してあるクラスモジュールを使いました。

クラスモジュール(クラス名 既定名のClass1)
'=====================================================
Private flno As Long
Private restsz As Long
Private buffer As Long
Function open_fl(flnm, buffzs As Long, flsize As Long) As Long
  On Error Resume Next
  flno = FreeFile()
  Open flnm For Binary As #flno
  open_fl = Err.Number
  If open_fl = 0 Then
    restsz = LOF(flno)
    buffer = buffzs
    flsize = restsz
    End If
  On Error GoTo 0
End Function
'=====================================================
Sub cls_fl()
  On Error Resume Next
  Close #flno
  On Error GoTo 0
End Sub
'=====================================================
Function get_fl(bt() As Byte, g_idx As Long) As Long
  On Error Resume Next
  Dim readbyte As Long
  If restsz <= 0 Then
    get_fl = 1
  Else
    If restsz >= buffer Then
     readbyte = buffer - 1
    Else
     readbyte = restsz - 1
     End If
    g_idx = Loc(flno)
    ReDim bt(readbyte)
    Get #flno, , bt()
    get_fl = Err.Number
    If get_fl = 0 Then
     restsz = restsz - readbyte - 1
     End If
    End If
  On Error GoTo 0
End Function
'=====================================================
Function put_fl(bt() As Byte, Optional fsz As Long) As Long
  On Error Resume Next
  Put #flno, , bt()
  If Not IsMissing(fsz) Then fsz = LOF(flno)
  put_fl = Err.Number
  On Error GoTo 0
End Function


標準モジュールに
'=============================================================
Sub mk_txtfile()
  Dim Bin As New Class1
  Dim bou As New Class1
  Dim g_idx As Long
  Dim mbyte() As Byte
  Dim flsz As Long
  Bin.open_fl ThisWorkbook.Path & "\sample.dat", 160, flsz
'                           ↑ここの160を80、240
'            に変えて実行して結果を確認してください。

  On Error Resume Next
  Kill ThisWorkbook.Path & "\text.txt"
  On Error GoTo 0
  bou.open_fl ThisWorkbook.Path & "\text.txt", 80, flsz
'       ↑こっちの80はダミーなのでなんでもよい  
  Do While Bin.get_fl(mbyte(), g_idx) = 0
    ReDim Preserve mbyte(UBound(mbyte) + 2)
    mbyte(UBound(mbyte)) = 10
    mbyte(UBound(mbyte) - 1) = 13
    bou.put_fl mbyte()
    Loop
   
  bou.cls_fl
  Bin.cls_fl
  set bou=nothing
  set bin=nothing
End Sub

として、mk_txtfile()を実行してみてください
クラスモジュールの内容は、この質問専用に作ったわけではないので
今回は、要らないパラメータが含まれています。

試してみてください。

尚、上記のブックのコードは、一度保存してから実行してください。
(Thisworkbook.Pathを使っているため)

0 hits

【54020】while分を使用した場合の最終行の処理について さや 08/2/20(水) 11:32 質問
【54021】Re:while分を使用した場合の最終行の処理に... VBWASURETA 08/2/20(水) 11:49 発言
【54022】Re:while分を使用した場合の最終行の処理に... さや 08/2/20(水) 11:58 質問
【54039】Re:while分を使用した場合の最終行の処理に... ichinose 08/2/20(水) 22:21 発言

28006 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free