[三流君] −−> [VBAで楽しく] −−> [バックナンバー一覧]

三流君VBA:テキストファイル処理 指定した行を取り除いて複製を作る

概要:単なるテキストファイルを使った処理です。手作業でもできるけど、量が多かったので作ってみました。
時間的には、手作業のほうが速かったかも(作成、テスト、含めると手作業で操作したほうが)
まぁ、一度作れば同じような処理に使えるので、ヨシとしますか。



発行内容

VBAテキストファイル処理 指定した行を取り除いて複製を作る

こんにちは。
今回は、xxxx.html ファイルから
<!--- アンケート --->
  ・
  ・
  ・
  ・
<!--- アンケートここまで --->
を取り除いて、複製を作る。
そんな テキストファイル処理にチャレンジしてみます。



/* * 1. 今回のキッカケ */

下記、私のホームページで行っている、満足度(評価)のアンケート処理なのですが、 <!--- アンケート ---> <FORM ACTION="a.asp" METHOD="POST" TARGET="_top"> <INPUT TYPE="HIDDEN" NAME="K" VALUE="VBA"> <INPUT TYPE="HIDDEN" NAME="NO" VALUE="131"> <table border=0 cellpadding=8 width=100%><tr> <td bgcolor="#ccffcc"><font size=-1>No.131を読んだ満足度(評価)は?<br> 5<INPUT TYPE="RADIO" NAME="a" VALUE="5">満足(参考になった)<br> 4<INPUT TYPE="RADIO" NAME="a" VALUE="4">まぁまぁ(一部参考になった)<br> 3<INPUT TYPE="RADIO" NAME="a" VALUE="3">普通(どちらとも言えない)<br> 2<INPUT TYPE="RADIO" NAME="a" VALUE="2">なんかなぁ(期待と違った)<br> 1<INPUT TYPE="RADIO" NAME="a" VALUE="1">不満(読んで損した気分)<br> <INPUT TYPE="SUBMIT" NAME="btn01" VALUE="評価を送る"></font></td> <td bgcolor="#eeeeff"><font size=-1> 作者に<b>感想・質問</b>を送る(気軽に質問・感想書いてください)<br> あなたのお名前(ニックネーム) <INPUT TYPE="TEXT" NAME="username" SIZE=30 VALUE="読者A">さん<br> <TEXTAREA NAME="HONBUN" ROWS=4 COLS=60>質問/感想</TEXTAREA><br> 作者からの返信は、 <INPUT TYPE="RADIO" NAME="re" VALUE="noreturn" CHECKED>不用 <INPUT TYPE="RADIO" NAME="re" VALUE="bbs">掲示板 <INPUT TYPE="RADIO" NAME="re" VALUE="email">E-mail <INPUT TYPE="TEXT" NAME="email" SIZE=24 VALUE="xxxx@xxx.xxx">で受信したい<br> <INPUT TYPE="SUBMIT" NAME="btn02" VALUE="質問・感想を送信"> *質問・感想はメルマガで紹介する場合があります </font></td></table></FORM> <!--- アンケートここまで ---> 荒れてます(おぃおぃ)、 で、今回やりたい処置は(作るプログラムは)、 vbaバックナンバーのHTMLファイルから、 <!--- アンケート ---> 〜 <!--- アンケートここまで ---> の間を抜いて、複製を作りたいと思います。 ※今回限りなので、エディターでやってもいいんだけど。  VBAのテキストファイル処理の復習を兼ねて、  作成してみたいと思います。 三流君VBAでテキストファイル(textfile)を操作する http://www.ken3.org/cgi-bin/group/vba_textfile.asp ↑も、あわせて 見てください。

/* * 2.まずは、テキストファイルを1行読み、1行書く(単純にコピーかな) */

まぁ、データを除く前に、そのままコピーしてみます。 仕様書は単純に、 セル B5 に 入力ファイル名 セル B7 に 出力ファイル名 上記を入れて、実行ボタンが押されたら、
Sub TEST182_001()
'・入力ファイル(B5)を開く、出力ファイル(B7)を新規に開く
'・入力ファイルの最後まで
  '・1行読み込み
  '・1行書き込み
'・ファイルを閉じる
End Sub
こんなラフな感じで、直接テスト用関数にコメント書いただけです。 ファイルのオープンは [No.27 テキストファイル処理 ファイルへの書き込み] http://www.ken3.org/vba/backno/vba027.html 開けて(Open)、書いて(Print #)、閉めて(Close)の流れを書いてます。 読み込みは、 [No.29 テキストファイル処理 ファイルからの読み込み] http://www.ken3.org/vba/backno/vba029.html 書き込みの次は読み込みじゃないけど、 ・Input Line #で1行リード ・EOF(No) で、ファイルの終わりをチェック ・Instr関数で文字列を探した そんなことを書いてます。 上記2つを参考にして、下記のように作成しました。 '・入力ファイル名(セルB5)を開く、出力ファイル名(セルB7)を新規に開く '・入力ファイルの最後まで '・1行読み込み '・1行書き込み '・ファイルを閉じる
Sub TEST182_001()

    Dim strInFileName  As String  '入力ファイル名
    Dim strOutFileName As String  '出力ファイル名
    Dim strBUFF        As String  'レコードを読みこむバッファ
    Dim nCNT           As Integer 'レコード数を数える

    '入力ファイルの処理
    strInFileName = Range("B5") '入力ファイル名はB5から代入
    If Dir(strInFileName) = "" Then 'Dir関数で ファイルの存在チェック
        MsgBox strInFileName & "が見つかりません"
        Exit Sub
    End If
    Open strInFileName For Input As #1 'ファイル番号1 入力モードで開く

    '出力ファイルの処理
    strOutFileName = Range("B7") '出力ファイル名はB7から
    Open strOutFileName For Output As #2 'ファイル番号2で出力ファイル作成
    
    '入力ファイルの最後まで1行毎に読んで判断する
    nCNT = 0 '出力行カウンタを初期化
    Do While EOF(1) = False    'ファイル番号1(入力)がある間ループ
        Line Input #1, strBUFF 'ここで1行読み、変数へ代入される
        Print #2, strBUFF      'そのまま、変数をファイルに書き込む
        nCNT = nCNT + 1        '出力行数をカウントする
    Loop
   
    'ファイルは閉じようね
    Close #1  '入力ファイル
    Close #2  '出力ファイルも忘れずに

    '結果を表示
    MsgBox strOutFileName & "に" & nCNT & "行書き込みました"

End Sub

/* * 3.該当範囲を書き込まない 書き込みストップ と 再開の判断 */

まぁ、全てを書き込む処理ができたので、 次は、 セル B9 に 除外開始の文字列 ( <!--- アンケート ---> ) から セル B11 に 除外範囲終了の文字列 ( <!--- アンケートここまで ---> ) まで を セットして、ファイルの書き込み範囲をコントロールしてみます。 '・入力ファイル名(セルB5)を開く、出力ファイル名(セルB7)を新規に開く '・入力ファイルの最後まで '・1行読み込み '除外の判断 セルB9と=になったら 書き込みOFF セルB11と=になったら再開 書き込みONにする '・1行書き込み '・ファイルを閉じる
Sub TEST182_002()

    Dim strInFileName  As String  '入力ファイル名
    Dim strOutFileName As String  '出力ファイル名
    Dim strBUFF        As String  'レコードを読みこむバッファ

    Dim strCUT_Start   As String  '除外開始(書き込み停止)の文字列
    Dim strCUT_End     As String  '除外終了(書き込み再開)の文字列
    Dim bWriteFlg      As Boolean '書き込みフラグ ブール型
    Dim nCNT           As Integer '削除範囲の数を数える

    '入力ファイルの処理
    strInFileName = Range("B5") '入力ファイル名はB5から代入
    If Dir(strInFileName) = "" Then 'Dir関数で ファイルの存在チェック
        MsgBox strInFileName & "が見つかりません"
        Exit Sub
    End If
    Open strInFileName For Input As #1 'ファイル番号1 入力モードで開く

    '出力ファイルの処理
    strOutFileName = Range("B7") '出力ファイル名はB7から
    Open strOutFileName For Output As #2 'ファイル番号2で出力ファイル作成
    
    '入力ファイルの最後まで1行毎に読んで判断する
    nCNT = 0 '削除カウンタを初期化
    bWriteFlg = True  '書き込みを初めはONにする
    strCUT_Start = Range("B9")   'セルB9から開始条件を代入する
    strCUT_End = Range("B11")    'セルB11から終了条件を代入する
    
    Do While EOF(1) = False    'ファイル番号1(入力)がある間ループ
        Line Input #1, strBUFF 'ここで1行読み、変数へ代入される
        
        '除外開始の確認
        If strBUFF = strCUT_Start Then
            bWriteFlg = False   '書き込みをOFFにする
            nCNT = nCNT + 1 '除外範囲数を+1する
        End If
        
        '書き込み処理
        If bWriteFlg = True Then  '書き込みの判断
            Print #2, strBUFF     'そのまま、変数をファイルに書き込む
        End If
        
        '除外終了の判断
        If strBUFF = strCUT_End Then
            bWriteFlg = True   '書き込みをONにする
        End If
    Loop
   
    'ファイルは閉じようね
    Close #1  '入力ファイル
    Close #2  '出力ファイルも忘れずに

    '結果をイミディエイトにDebug.printで表示
    Debug.Print strOutFileName & ":" & nCNT & " ブロック 削除して 書き込みました"

End Sub
単純に1つ変数 Dim bWriteFlg As Boolean '書き込みフラグ ブール型 を作り、 開始は '除外開始の確認 If strBUFF = strCUT_Start Then bWriteFlg = False '書き込みをOFFにする で、 再開は、 '除外終了の判断 If strBUFF = strCUT_End Then bWriteFlg = True '書き込みをONにする で判断して、True/falseをコントロールして、 書き込み処理 で If bWriteFlg = True Then '書き込みの判断 Print #2, strBUFF 'そのまま、変数をファイルに書き込む End If のように使い、判断しました。

/* * 4.複数ファイルを連続で処理する。 */

単独のファイルから 指定した範囲をなんとか除外して コピーすることができました。 5話単位の バックナンバーは 27個、 1話単位は 181個のhtmlファイルがあります。 このファイル名をB5 と B7を変えて 実行ボタンを押す、 そんな処理を行うと大変なので、 20行目から B列に入力ファイル C列に出力ファイル B20 入力ファイル C20 出力ファイル B21 入力ファイル C21 出力ファイル    ・        ・    ・        ・    ・        ・    ・        ・ B50 入力ファイル C50 出力ファイル 1 と、入出力ファイル名を書き込み、1つ1つ B5とB7に代入して 連続処理してみます。 ※まぁ、バックナンバーは連番だから、プログラムで用意できるけど・・・ 'B20から データがなくなるまで、 'B5 入力ファイル名 B7 出力ファイル名 に それぞれデータをセット後、 'ファイル処理の TEST182_002 を コールする
Sub TEST182_MAIN()

    Dim y As Integer
    
    For y = 20 To 9999  '実際に9999までループはしないけど
        'いきなりY行目のデータ存在チェック、無きゃループを抜ける
        If Trim(Cells(y, "B")) = "" Then Exit For  '空白かチェックする
        Cells(y, "B").Select  'カーソル移動 セルの選択(必要ないけど、おまけ)
        
        '入力ファイル名(B5) と 出力ファイル名(B7) を セットする
        Range("B5") = Trim(Cells(y, "B"))  '入力ファイル名
        Range("B7") = Trim(Cells(y, "C"))  '出力ファイル名
        
        '↑パラメーターセット後↓ファイル処理の関数を呼ぶ
        Call TEST182_002   '単純にコール、呼んだだけです。
    Next y

    MsgBox "処理が終了しました、確認してください。"
    Range("B15").Select  'カーソルを戻す。

End Sub
ポイント は ループを作って、 '入力ファイル名(B5) と 出力ファイル名(B7) を セットする Range("B5") = Trim(Cells(y, "B")) '入力ファイル名 Range("B7") = Trim(Cells(y, "C")) '出力ファイル名 で、パラメータをセットして 単独実行の関数を呼んだ、ただ、それだけです。

/* * 5.終わりの挨拶 */

今回は、 ・テキストファイルの オープン ・読み込みと書き込み ・指定範囲を書かない(カットする) ・連続実行 なんて流れでした。 ファイルを選択したい や 上書き処理ができないなど、まだまだ、問題あるけど、 部分カットで使ってみます。 ※あとは、広告などの 部分 差し替え(交換)があるといいのかなぁ。 プログラム作りは ^^^^^^^^^^^^^^^^ う〜ん・・・ まぁ、人それぞれ、十人十色、百社百色だけどね。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 今回も逃げるように。。。。失礼します。


ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、

種類別のリンク や 広告など

気になったジャンル↓を選択してください。

人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記3つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です

Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他:VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます

開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う]

仕様書(設計書?) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力]

※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。
※※読んで、気分を悪くされたらスミマセン。

Blogとリンク:[三流君の作業日記]/ [VBAやASPのサンプルコード]/ 広告-[通販人気商品の足跡]



[三流君(TOP ken3.org へ戻る)] / [VBA系TOPへ] / [VBA系バックナンバー目次へ移動]