[三流君] −−> [プログラマー業務の愚痴] −−> [バックナンバー一覧]
−−> No.035 Excel97 VBA CSVから固定長 読者からアドバイス〜

Excel97 VBA CSVから固定長 読者からアドバイス〜


本文(発行内容)


<Excel97 VBA CSVから固定長 読者からアドバイス〜>
目次
1.はじめの挨拶
2.読者より、アドバイス 関数分割について
3.読者より、アドバイス 自作関数作ってみました
4.質問コーナー?
5.おわりの挨拶
----------------------------------------------------------------------------
/*
 * 1.こんにちは
*/
こんにちは。
今回は、前回の積み残し、
Excel97 VBA CSVから固定長
です。読者より2・3ヒントをいただきました。

なぜか、FTPの調子が悪いので、HPは、更新していません
(今回、画像付き、サンプルありませんが、、、)

えっ、画像はいつも見てないって、、そんなこと言わないで、、
見てくださいよ。
(ホントのところは、どうなんだろう?)

/*
 * 2.読者より、アドバイス 関数分割について
*/
転載不可、ken3の言葉で書いてください
と書かれたメールでアドバイスをいただきました。
ア.関数は、分割してください。
  前回のサンプル、1つのモジュールに詰込んでました。
  ファイル名作成・処理・結果をメモ帳で表示。
  これだと、1つ1つがわかりにくいみたいなので、
  今回、メイン部分と呼び出し側の2つに分けました。
  幕ノ内弁当で、おかずのエリアを分けた。。
  シャケがおいしければ、シャケだけ抜いて、
  シャケ弁当を作りやすいように、
  1つ1つの単位に分けるって、大切かもしれません。
  *アドバイス、どうもです。
  マズイ組み合わせがあったら、そこだけ修正、、後々の流用ですね。
イ.Strconvで変換後処理してみては?
  文字コードでバイト数がわからないなら、
  strconvで変換後処理してみては?
  と、アドバイス含めて、いただきました。
  (回答をズバリ書いてくれないのが、ホントはやさしい師匠?)

私なりの答え(再度の味付け)を下記に記載します。
*まだ、変換サイズなどを外部に出すなど、してませんが、、
'--------
Sub TEST_MAIN()

    Dim strINFname  As String
    Dim strOUTFname As String

    ' csvtotxt.xls のパスを使用して、INファイル、Outファイルの
    'ファイル名を作成する
    strINFname = ActiveWorkbook.Path & "\Sample.txt"
    strOUTFname = ActiveWorkbook.Path & "\out.txt"
    
    'お行儀良く、入力ファイルがアルか、チェックしますか、、、
    If Len(Dir(strINFname) & "") = 0 Then
        MsgBox strINFname & "ファイルが見つかれません"
        Exit Sub  'モジュールを抜ける
    End If

    'サンプルモジュールをコールする
    Call Excel97_CSVtoTXT(strINFname, strOUTFname)

    '結果をメモ帳表示
    Shell "notepad.exe " & strOUTFname, vbNormalFocus

End Sub

'サンプルモジュール
'固定処理が多いので流用・汎用性が無い、なぁ。。
'サイズを(も)引数で渡したり、工夫しないと、、
Sub Excel97_CSVtoTXT(strINFname As String, strOUTFname As String)
    
    Dim nYLINE As Integer
    Dim x      As Integer
    Dim OUT_FNO%
    
    Dim nOUTSIZE(10) As Integer     '10もいらないでしょ、、、
    Dim strOUTBUF As String
    
    '入力ファイルをCSVで開く      ↓変数に変更
    Workbooks.OpenText FileName:=strINFname, StartRow:=1, DataType:= _
        xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
        Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False _
        , FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), _
        Array(6, 2))
        
    '出力テキストファイルを作成する
    'シーケンシャル ライト モードで開きます
    OUT_FNO = FreeFile
    Open strOUTFname For Output As #OUT_FNO
    
    '出力先のサイズを代入
    'サンプルデータは会員番号1(8桁)、漢字氏名(20桁)、ローマ字
    '(18桁)、生年月日(10桁)、会員番号2(10桁)、暗証番号
    '(3桁)で構成されています。
    nOUTSIZE(1) = 8
    nOUTSIZE(2) = 20
    nOUTSIZE(3) = 18
    nOUTSIZE(4) = 10
    nOUTSIZE(5) = 10
    nOUTSIZE(6) = 3
    
    'データが無くなるまでループ(A列が空白になるまで)
    'おいおい、データが1行しかなかったら、どうなるの?<<<知らない、、
    nYLINE = 2   'タイトルを抜かし、2行目から、スタート
    While Len(Cells(nYLINE, 1) & "") <> 0
        For x = 1 To 6 'AからF列まで処理
            strOUTBUF = Cells(nYLINE, x)
            'XXバイトに満たない場合、空白を後ろに詰めています
            strOUTBUF = LeftB(StrConv(strOUTBUF & Space(nOUTSIZE(x)), vbFromUnicode), nOUTSIZE(x))
            strOUTBUF = StrConv(strOUTBUF, vbUnicode)
            'データ書きこみ
            Print #OUT_FNO, strOUTBUF; '←を付けると改行されない
        Next x
        Print #OUT_FNO, ""     '改行のみする
        nYLINE = nYLINE + 1  '忘れないようにカウントアップ
    Wend
    
    Close #OUT_FNO                  ' ファイルを閉じます。

End Sub
'--------
こんな感じです。







/*
 * 3.読者より、アドバイス 自作関数作ってみました
*/
無いものは、自分で作ろうって、こころ、忘れてた、、、
読者からいただいた、固定長、右スペース埋め関数です。。
'----------------------------------------
Public Function SetKoteicho(input_str As String, length As Integer) As String
    Dim check_char As Integer       'Asc関数で全角かどうか調べる文字の位置
    Dim sjis_length As Integer      'シフトJIS換算の文字数
    Dim sjis_code As Integer        '文字コード(シフトJIS)
    Dim output_str As String        '固定長に変換した文字列
    sjis_length = 0
    check_char = 1
    Do
        sjis_code = Asc(Mid(input_str, check_char, 1))
        '文字コードから全角文字か半角文字かを調べる
        If sjis_code > 256 Or sjis_code < 0 Then
            '全角文字
            sjis_length = sjis_length + 2
        Else
            '半角文字
            sjis_length = sjis_length + 1
        End If
        check_char = check_char + 1
    Loop While (check_char <= Len(input_str))
    
    '必要なだけスペースを加える
    output_str = input_str & Space$(length - sjis_length)
    
    SetKoteicho = output_str
End Function
'--------------------------------------

'下記のようにコールすると、使用できます
        For x = 1 To 6 'AからF列まで処理
            '感謝して、関数を使用する、、、
            strOUTBUF = SetKoteicho(Cells(nYLINE, x), nOUTSIZE(x))
      '-----------↑^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            Print #OUT_FNO, strOUTBUF; '←を付けると改行されない
        Next x
'--------------------------------------

ありがたいですね、、、ホント。

/*
 * 4.質問コーナー?
*/
----------
>VBでVoice Clockを作ってみたいのですが...
>簡単な方法が有りますか。
>朝、昼、夕方の三回だけしゃべってくれればいいのですが。
----------

タイマーイベントのネタで使用かなぁ、、、
ネタようにメモメモ。

/*
 * 5.終わりの挨拶
*/
今回、読者任せでした(厨房を貸して、料理作ってもらった?)

年末ですね、、、来年は構想を考えて、
少しは、講座らしくしようかなぁ?

では、また。 三流PG Ken3でした。



ページフッター

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

リンクや広告など

項目別に本音?それとも建て前?的な記事をまとめました。

気になったジャンル↓を選択してください。
[ルーキー rookies]・・・ 新人さん達 初心者さんへ
[学ぶ study]・・・学習、技術の取得
[仕様書 doc]・・・仕様書・設計書関係の話
[共同作業 team]・・・チーム、グループ作業
[プログラムは心? spirit]・・・プログラマー 心・気質・魂

[掲示板デビューしようぜ bbs]・・・掲示板関係の話、質問者・回答者の気持ちほか
[昔はできた seo]・・・三流式の効果無しSEOとアフィリエイト
[仕事や作業、転職 job]・・・仕事や転職、評価、作業など
[その他 etc]・・・その他 分類外の記事

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

Blogとリンク:[三流君の作業日記]/ [愚痴(Bookmark)]/ [広告Blog(Bookmark)]



[三流君(TOP ken3.org へ戻る)] / [プログラマー業務の愚痴] / [バックナンバー 一覧]