====*====*====*====*====*====*====*====*====*====*====*====*====*====*====*= [ 三流ＰＧ 番外編 今日の一品 No.019-1 ] 2000/04/03 月曜日 発送予定 =*====*====*====*====*====*====*====*====*====*====*====*====*====*====*==== 三流ＰＧ 番外編 今日の一品 は 隠し味として、 軽めのＶＢＡ関係のサブルーチンを載せていきたいと思います。 ----------------------------------------------------------------------------縦書用数値変換改良
番外編 NO.19 に対して、下記のメールいただきました。 *ありがたいです、反応していたただいて。 ---------------- In message "縦書用数値変換ルーチンを改造してみました", Date Fri, 31 Mar 2000 18:02:58 +0900 いがちゃん さん wrote... >>====*====*====*====*====*====*====*====*====*====*====*====*====*====*==== >>[ 三流ＰＧ 番外編 今日の一品 No.019 ] 2000/03/31 金曜日 発送予定 >>=*====*====*====*====*====*====*====*====*====*====*====*====*====*====*== >より > > 縦書用数値変換を自分なりに改良してみました。 >ゼロには対応していないけど、[Ｘ千Ｘ百Ｘ拾Ｘ萬]表示に対応 >しています。 >動作確認は VB5.0のみです。 > 数字判定の際に、ループで1文字ずつ調べずInStr判定という、 >Ｋｅｎ３さんのコードを改良できる部分多少ありです。 > >'//////////////////////////////////////////////////// >' 関数名 ：縦書用数値変換(ByRef Moji As String) As String >' 関数の目的：縦書き用文字列に変換する >' 作成日 ：2000/3/31 >' 最終更新日： >' 備考 ：ゼロ、先頭のゼロ、または変換後ゼロになる値は無視されます。 >' (例 "000" -> "", "4Ab08" -> "四Ab八") >'//////////////////////////////////////////////////// >Private Function 縦書用数値変換(ByRef Moji As String) As String > Dim WideMoji As String > Dim RET As String > Dim mcnt As Integer > Dim wmoji As String > Dim i As Integer > Dim cKeta As Integer > Dim flgBigKeta As Boolean > > Const SUJI = "１２３４５６７８９０" > Const KANJI = "壱弐参四五六七八九〇" > Const KETA = "拾百千" > '数字が1京以上になる場合、BIG_KETAを増やさなければならない > Const BIG_KETA = "萬億兆" > > '全角文字に変換する > WideMoji = StrConv(Moji & "", vbWide) > > Rem ハイフンの調整 > i = InStr(1, WideMoji, "−") > Do While i 'i = 0(ハイフンが存在しない、しなくなった)で終了 > Mid$(WideMoji, i, 1) = "ー" > i = InStr(1, WideMoji, "−") > Loop > > Rem 数字の調整 (文字列右から走査・置き換え・桁漢数字付加・大桁漢数字付加) > For i = Len(WideMoji) To 1 Step -1 > '一文字切り出し > wmoji = Mid$(WideMoji, i, 1) > > '切り出した一文字が数字かどうか調べる > '固定文字列SUJIに同じ文字があれば数字と判定できる > mcnt = InStr(SUJI, wmoji) > > If mcnt Then > '数字なら漢数字に変換 > '固定文字列SUJIと同位置にあるKANJI内文字と置き替える > 'そのためSUJIとKANJIは互いに同並びでなくてはならない > wmoji = Mid$(KANJI, mcnt, 1) > > '文字が"〇(ゼロ)"ならば、"〇百〇拾"等の表示になるため捨てる > If wmoji <> "〇" Then > '拾百千の位文字を追加 > If (cKeta Mod 4) Then > wmoji = wmoji & Mid$(KETA, (cKeta Mod 4), 1) > End If > > '大桁漢字付加フラグ > If flgBigKeta = False Then > '萬億兆の位文字を追加 > If (cKeta \ 4) Then > wmoji = wmoji & Mid$(BIG_KETA, (cKeta \ 4), 1) > flgBigKeta = True > End If > End If > Else > wmoji = vbNullString > End If > > cKeta = cKeta + 1 > '次大桁へ移ったら大桁漢字付加フラグをクリア > If (cKeta Mod 4) = 0 Then > flgBigKeta = False > End If > Else > '数字以外の文字のため、全角変換前の文字列をセット > wmoji = Mid$(Moji, i, 1) > '数字以外の文字が存在したため、桁計算をリセット > cKeta = 0 > '大桁漢字付加フラグをクリア > flgBigKeta = False > End If > > '連結 > RET = wmoji & RET > Next i > 縦書用数値変換 = RET >End Function > In message "さっきの改造版はバグがありました", Date Fri, 31 Mar 2000 18:56:36 +0900 いがちゃん さん wrote... >さっき送った改造版はバグがありました >せっかく最初にハイフン処理をしているのに、変換前文字列から >取得していました。 > >＜バグあり＞ >'数字以外の文字のため、全角変換前の文字列をセット >wmoji = Mid$(Moji, i, 1) > >＜デバッグ後＞ >'文字がハイフン(正確には長音記号)でなければ、元の文字列を使用 >If wmoji <> "ー" Then > 'ハイフン、数字以外の文字のため、全角変換前の文字列をセット > wmoji = Mid$(Moji, i, 1) >End If > >もしくは最初のハイフン処理をやめて、下記のようにしても良いです。 >＜デバッグ後、その２＞ >'文字がハイフンでなければ、元の文字列を使用 >If wmoji <> "−" Then > 'ハイフン、数字以外の文字のため、全角変換前の文字列をセット > wmoji = Mid$(Moji, i, 1) >Else > wmoji = "ー" >End If 手抜きで、メールをそのまま載せてしまいました。 （いがちゃん さんに感謝ですね） 自分へキツイ一言編？・グチ？ メールそのまま載せるのいいけど、 読者の人がテストや実験する時、 > ←の引用記号が入っていると、 そのままカット アンド ペースト できないジャン。 読者のこと考えてない不親切なヤツだなぁ？ そのあたりが、仕事や新人君の教育にでてるんだよねキット。 プログラムにも性格でるけど、メルマガにも性格でるねかなり？ 三流作者だなぁ、、 と声が聞こえてきたところで、このへんで、、 今日も逃げ出す、、、配慮が足りない Ｋｅｎ３ でした。
質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)
|
感想や質問・要望・苦情など 三流君へメッセージを送る。 時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。 |
| ←パソコンの技術系の書籍を探しているなら コンピュータ関連の出版社33社（アスキー、インプレス等）が共同運営するコンピュータの本・専門店 ※種類が豊富で探し易い※在庫ありが48時間以内発送 |