三流君VBA:プログラムの修正縦に羅列と配列で操作

発行内容

プログラムの修正縦に羅列と配列で操作

どうも、三流プログラマーのＫｅｎ３です。

今回は、
プログラムの修正・追加のいろいろな方法？
として、
縦に羅列と配列でループ
を比べて少し書いてみます。

自分でも読み返すとあまり参考にならないのですが、
せっかく書いたので発行しちゃいます。

読者の声：あっ、そのネタ知ってるよ。内容は・・・だろ？
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

またまたぁ・・・先に心の中でネタ先読みしないでよ。
私が最近、金曜日の夜に見ているドラマ
タイガー アンド ドラゴンの客じゃないんだからさ

-- 余談 --
落語を元ネタにして、よくできたドラマだと思う。
話の作り方とかテンポの切り替え方、落語のネタと現在の話の混ぜ方が絶妙かなぁ。
脚本家がすごいんだろうなぁ。
私のメルマガでもテンポの切り替え方とか取り入れたいけど・・・
と言いつつ、チョイ役の売れない洋服屋の女性店員がタイプで見てたり(笑)

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

前回のメルマガ
No.173 プログラムの修正・追加のいろいろな方法？
http://www.ken3.org/vba/backno/vba173.html
で、
下記の全角英数字を半角にする下記のサブルーチンを作成した。

Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに＋する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("０") To Asc("９") '全角０～９
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("ａ") To Asc("ｚ") '全角ａ～ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("Ａ") To Asc("Ｚ") '全角Ａ～Ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋

            Case Asc("（")             '（ カッコ
                strRET = strRET & "("  '半角の(を＋する
            Case Asc("）")             '） カッコ
                strRET = strRET & ")"  '半角の)を＋する
            Case Asc("／")             '／ スラッシュ
                strRET = strRET & "/"  '半角の/を＋する
            Case Asc("．")             '．ドット
                strRET = strRET & "."  '半角の.を＋する
            
            Case Else  'その他
                strRET = strRET & strCHK  '上記以外はそのまま＋する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function

ところが、このプログラムだと、下記のデータで不具合が発生した

Sub test()
    
    Dim strWORK As String
    Debug.Print "テスト結果:" & Now
    
    '2005-05-18 テスト
    strWORK = "Ｅｘｃｅｌ ＶＢＡ（ブイビーエー） ２０００／２００２対応"
    Debug.Print 全角ABCto半角ABC(strWORK)
    
    strWORK = "．ＮＥＴエンタープライズＷｅｂアプリケーション開発技術大全"
    Debug.Print 全角ABCto半角ABC(strWORK)
    
    '2005-05-25 テスト
    strWORK = "Ｖｉｓｕａｌ　Ｃ＃．ＮＥＴプログラミング入門"
    Debug.Print 全角ABCto半角ABC(strWORK)
    
    strWORK = "Ｍｉｃｒｏｓｏｆｔ　Ｖｉｓｕａｌ　Ｃ＋＋　．ＮＥＴランゲージリファレンス"
    Debug.Print 全角ABCto半角ABC(strWORK)

End Sub

テストデータ:
~~~~~~~~~~~~~
Ｖｉｓｕａｌ　Ｃ＃．ＮＥＴプログラミング入門
とか
Ｍｉｃｒｏｓｏｆｔ　Ｖｉｓｕａｌ　Ｃ＋＋　．ＮＥＴランゲージリファレンス

を変換すると、Ｃ＃やＣ＋＋の＃と＋がまだ変換されていなかった。

/*
 * ２．素直に縦に羅列して修正する
*/

ハイハイ、＃と＋と□(スペース)の変換を足せばいいんだろ。
ほらよ、CASE文の条件を増やしてやったよ。

Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに＋する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("０") To Asc("９") '全角０～９
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("ａ") To Asc("ｚ") '全角ａ～ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("Ａ") To Asc("Ｚ") '全角Ａ～Ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
                
            Case Asc("（")             '（ カッコ
                strRET = strRET & "("  '半角の(を＋する
            Case Asc("）")             '） カッコ
                strRET = strRET & ")"  '半角の)を＋する
            Case Asc("／")             '／ スラッシュ
                strRET = strRET & "/"  '半角の/を＋する
            Case Asc("．")             '．ドット
                strRET = strRET & "."  '半角の.を＋する
            
            '2005-05-25 条件追加
            Case Asc("＃")             '＃シャープ
                strRET = strRET & "#"  '半角の#を＋する
            Case Asc("＋")             '＋プラス
                strRET = strRET & "+"
            Case Asc("　")             '□(全角スペース)
                strRET = strRET & " "  '半角のスペースを＋する
            
            Case Else  'その他
                strRET = strRET & strCHK  '上記以外はそのまま＋する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function

これで、文句無いだろ。
他にも文字が発生してきたら、
            '2005-05-25 条件追加
            Case Asc("＃")             '＃シャープ
                strRET = strRET & "#"  '半角の#を＋する
            Case Asc("＋")             '＋プラス
                strRET = strRET & "+"
            Case Asc("　")             '□(全角スペース)
                strRET = strRET & " "  '半角のスペースを＋する
みたいに、修正すればいいんだよ。

行動は素直じゃないのに、
プログラムは単純に書くよねキミ達は？
まぁ動けば何でもいいんだけどね、文句も無いけど言ってみただけ。

/*
 * ３．配列にしてループで回してみた。
*/

久々にムカっと来た。
少し先に生まれたからって(少し先に入社したからって)偉そうにするんじゃねぇよ。

だったら配列で変換する文字を管理して、ループで回してやるよ。
        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    '2005-05-25 追加
    Dim str全角(8) As String
    Dim str半角(8) As String
    Dim nLOOPCNT As Integer   'ループのカウンタ

    '配列に文字をセットする
    str全角(0) = "　": str半角(0) = " " '□(全角スペース)
    str全角(1) = "（": str半角(1) = "(" '（ カッコ
    str全角(2) = "）": str半角(2) = ")" '） カッコ
    str全角(3) = "／": str半角(3) = "/" '／ スラッシュ
    str全角(4) = "．": str半角(4) = "." '．ドット
    str全角(5) = "＃": str半角(5) = "#" '＃シャープ
    str全角(6) = "＋": str半角(6) = "+" '＋プラス
    str全角(7) = "－": str半角(7) = "-" '－マイナス、ハイフン

    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに＋する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("０") To Asc("９") '全角０～９
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("ａ") To Asc("ｚ") '全角ａ～ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("Ａ") To Asc("Ｚ") '全角Ａ～Ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Else  'その他
                '配列の文字と一致するかチェックする 2005-05-25修正
                For nLOOPCNT = 0 To 7
                    If strCHK = str全角(nLOOPCNT) Then  'チェックする全角文字と一致するか?
                        strCHK = str半角(nLOOPCNT)  '対応する半角文字をセットする
                        Exit For  'ループを強制的に抜ける
                    End If
                Next nLOOPCNT
                strRET = strRET & strCHK  'strCHKを＋する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function

こんな感じで、始めに配列に
    str全角(0) = "　": str半角(0) = " " '□(全角スペース)
    str全角(1) = "（": str半角(1) = "(" '（ カッコ
    str全角(2) = "）": str半角(2) = ")" '） カッコ
    str全角(3) = "／": str半角(3) = "/" '／ スラッシュ
    str全角(4) = "．": str半角(4) = "." '．ドット
    str全角(5) = "＃": str半角(5) = "#" '＃シャープ
    str全角(6) = "＋": str半角(6) = "+" '＋プラス
    str全角(7) = "－": str半角(7) = "-" '－マイナス、ハイフン
とデータをセットして、
    For nLOOPCNT = 0 To 7
        If strCHK = str全角(nLOOPCNT) Then  'チェックする全角文字と一致するか?
            strCHK = str半角(nLOOPCNT)  '対応する半角文字をセットする
            Exit For  'ループを強制的に抜ける
        End If
    Next nLOOPCNT
ループで回してチェックして、一致したら置換する感じです。

/*
 * ４．配列の初期化にArray関数使ってみたら？
*/

配列の初期化で
    str全角(0) = "　": str半角(0) = " " '□(全角スペース)
    str全角(1) = "（": str半角(1) = "(" '（ カッコ
と縦に書くのかぁ・・・

これはこれでわかりやすいけど、Array関数を使ってみたら？
Array関数使えよ
 と
   どれだけの読者が心に思ったか？興味があるけど、

まず、
Dim str全角 As Variant '*1 変数をVariantで宣言
Dim str半角 As Variant
とVariant型で変数を宣言してから、

str全角 = Array("　", "（", "）", "／", "．", "＃", "＋", "－")
str半角 = Array(" ", "(", ")", "/", ".", "#", "+", "-")
こんな感じ？で使用します。※配列を作成できます。

あまり変化無いけど、こんな感じで初期化文を書くことができたので、

Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    '2005-05-25 追加
    Dim str全角 As Variant '*1 変数をVariantで宣言
    Dim str半角 As Variant
    Dim nLOOPCNT As Integer   'ループのカウンタ

    'Array関数で配列を初期化する
    str全角 = Array("　", "（", "）", "／", "．", "＃", "＋", "－")
    str半角 = Array(" ", "(", ")", "/", ".", "#", "+", "-")
    
    strRET = "" 'リターン値の初期化
    '文字数分コードを調べて変換して、strRETに＋する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("０") To Asc("９") '全角０～９
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("ａ") To Asc("ｚ") '全角ａ～ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("Ａ") To Asc("Ｚ") '全角Ａ～Ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Else  'その他
                '配列の文字と一致するかチェックする 2005-05-25修正
                For nLOOPCNT = 0 To 7
                    If strCHK = str全角(nLOOPCNT) Then  'チェックする全角文字と一致するか?
                        strCHK = str半角(nLOOPCNT)  '対応する半角文字をセットする
                        Exit For  'ループを強制的に抜ける
                    End If
                Next nLOOPCNT
                strRET = strRET & strCHK  'strCHKを＋する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function

でも、あんまり変わらないね・・・

-- 補足宣伝 --

配列とＡｒｒａｙ関数
http://www.ken3.org/vba/backno/vba008.html
も見てね。

/*
 * ５．配列の要素数(MAXの数)を知るのにUBound関数を使ってみたら？
*/

配列の初期化でArray関数を説明したら次はアレだろ？
と
心の中で文句を言われていた読者の方、お待たせしました。
心に浮かんだ関数、UBound関数で当りです。

Array関数を使用して修正を簡単に作っているのですが、
    'Array関数で配列を初期化する
    str全角 = Array("　", "（", "）", "／", "．", "＃", "＋", "－")
    str半角 = Array(" ", "(", ")", "/", ".", "#", "+", "-")
例えばこれに、
＊(アスタリスク)を追加します。
まぁ、後ろに追加するだけなんだけど
    'Array関数で配列を初期化する
    str全角 = Array("　", "（", "）", "／", "．", "＃", "＋", "－","＊")
    str半角 = Array(" ", "(", ")", "/", ".", "#", "+", "-", "*")
これだけだと、修正が足りなかったり。

えっ、どこが？全角と半角、追加しとるよ。
※見難いけど(醜いけど)順番は間違っていないよ

せっかく追加したのに、下記のループのカウンタ
    '配列の文字と一致するかチェックする 2005-05-25修正
    For nLOOPCNT = 0 To 7
        If strCHK = str全角(nLOOPCNT) Then  'チェックする全角文字と一致するか?
            strCHK = str半角(nLOOPCNT)  '対応する半角文字をセットする
            Exit For  'ループを強制的に抜ける
        End If
    Next nLOOPCNT

ここが、０から７のままだと・・・あっ、やられましたね。
ここを１文字増えたので８にしないと。

そこで知りたいのが配列の要素の数、
Array関数やSplit関数で作成された配列の要素数を知るのに便利なUBound関数

UBound(変数名)で配列のサイズ、数を返してくれます。
^^^^^^^^^^^^^^
    For nLOOPCNT = 0 To UBound(str全角)
と使用してループを作成すればOKです。

-- 補足宣伝 --

関数に汎用性を持たせる、共通に使える関数作り
http://www.ken3.org/vba/vba-hanyo.html

Split関数とUBound関数のサンプルを解説
http://www.ken3.org/cgi-bin/test/test024-2.asp

ArrayとUboundで項目名を管理してWhere句を作成
http://www.ken3.org/cgi-bin/test/test093-2.asp

も見てね。

/*
 * ６．一文字探すんだったら文字列からInStr関数でいいんじゃないの？
*/

ここまで読んだ読者の感想を予想すると、
一文字探すんだったら文字列からInStr関数でいいんじゃないの？
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
※心の中で文句を言われていた読者の方、お待たせしました。
  (オイオイ、待ってないって？)

配列を作成して、
    For nLOOPCNT = 0 To UBound(str全角)
        If strCHK = str全角(nLOOPCNT) Then  'チェックする全角文字と一致するか?
            strCHK = str半角(nLOOPCNT)  '対応する半角文字をセットする
            Exit For  'ループを強制的に抜ける
        End If
    Next nLOOPCNT
と
配列内に該当する文字があったら、自分で置換してましたが、
この処理を
配列内を０からループで探す そんな考え方
から
文字列の中から該当する文字(１文字)を探す
に
方針を変更してみたいと思います。

文字列から文字列を探す場合、便利なInStr関数があります。
この関数を使って修正してみます。

Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    '2005-05-25 追加
    Dim str全角 As String
    Dim str半角 As String
    Dim nSERCH  As Integer  '場所を覚える変数

    '全角の文字列と半角の文字列を作成する
    str全角 = "　（）／．＃＋－＊"
    str半角 = " ()/.#+-*"
    
    strRET = "" 'リターン値の初期化
    '文字数分コードを調べて変換して、strRETに＋する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("０") To Asc("９") '全角０～９
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("ａ") To Asc("ｚ") '全角ａ～ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Asc("Ａ") To Asc("Ｚ") '全角Ａ～Ｚ
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して＋
            Case Else  'その他
                '変換候補の変数 str全角の中に存在するか?チェックする 2005-05-25修正
                nSERCH = InStr(str全角, strCHK)  'InStr関数でstr全角からstrCHKを探す
                If nSERCH > 0 Then  '見つかった、場所が０以上か？
                    strCHK = Mid(str半角, nSERCH, 1)  '半角のn番目を代入する(に置き換える)
                End If
                
                strRET = strRET & strCHK  'strCHKを＋する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function

まず、全角と半角の文字列を用意します。
    '全角の文字列と半角の文字列を作成する
    str全角 = "　（）／．＃＋－＊"
    str半角 = " ()/.#+-*"
※↑文字の順番を間違えないでね・・・(一文字でもずれるとシャレニならないよ)

次にチェック対象の全角文字が存在するか探します。
    nSERCH = InStr(str全角, strCHK)  'InStr関数でstr全角からstrCHKを探す
    If nSERCH > 0 Then  '見つかった、場所が０以上か？
        strCHK = Mid(str半角, nSERCH, 1)  '半角のn番目を代入する(に置き換える)
    End If
    strRET = strRET & strCHK  'strCHKを＋する

もし、みつかると、nSERCHに位置が返ります。
nSERCH > 0 だったら、対応する半角の文字をstrCHKにセットして(置き換えます)

変数をわかりやすく見えるようにするとこんな感じかな？
str全角 = "　（）／．＃＋－＊"
str半角 = " ()/.#+-*"
strCHK = "／"
だと、
nSERCH = InStr("　（）／．＃＋－＊", "／")
で、
nSERCHには、4が入る。
で、>0なので、
strCHK = Mid(" ()/.#+-*", 4, 1)  '半角のn番目を代入する(に置き換える)
と、
strCHKは、/が代入され、

strRET = strRET & "/"  'strCHKを＋する
で、無事に半角となる。(半角を&でつなげた文字列が作成される)

/*
 * ７．終わりの挨拶
*/

今回は、
配列とループ、
そんな話でした。

プログラム作りは
^^^^^^^^^^^^^^^^
う～ん・・・
まぁ、人それぞれ、十人十色、百社百色だけどね。
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
次回に含みを持たせつつ、今回も逃げるように失礼します。

ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。

ページフッター

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

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

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

人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作するサンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記３つみたいな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系バックナンバー目次へ移動]