半角カタカナのみ全角にするには

質問

http://bekkoame.okwave.jp/qa8426331.html
を参考にｖｂａコードを作っています。

"あああイイイ"（「イイイ」のみ半角カタカナ）
を
"あああイイイ"
にしたいのですが、

Sub Macro01()
Dim str置換前 As String '置換前の文字列
Dim str置換後 As String '置換後の文字列
Dim i As Integer
str置換前 = "あああイイイ"

str置換後 = str置換前
For i = 31850 To 31936
str置換後 = Replace(str置換後, StrConv(Chr(-i), vbNarrow), Chr(-i))
Next i

MsgBox str置換前
MsgBox str置換後
End Sub

を実行すると、
「あああ」が全角カタカナになり、「アアアイイイ」になってしまいます。

For i = 31850 To 31936
の部分に原因があるのかな、とは思いますが、
For i = 31850 To 31936の意味がよくわからないままコピペで使ってしまいました。

多分文字コードの数値だと思うのですが、どう変更すれば、ひらがなは除外されますか？
よろしくお願いします。

回答No.6

real beatin（@realbeatin） · ベストアンサー

＃５の訂正です。

＃５の関数に余計な処理が残っていましたので、修正版を再提示します。
失礼しました。
＃３であげた３種についてもパフォーマンス向上を意図して
更に修正を加えたい箇所が幾つかあるにはありますが、
どのみち文字数制限で説明コメントを書き切れないので、諦め、
もっとも責任ある態度で書くべき＃５に限って修正します。
＃５-６で書換えた分では、＃３の関数とのタイム比較で
約８～１１倍だったものが約４～７倍ぐらいまで近づいてはいます。
パフォーマンス向上だけ考えるなら他にも方法はありますが、
それでは設計的に一貫性のないものになってしまいそうですし、
やはりReplace()関数には限界がありますから、ほどほどに。
変更点
（小文字の"ヵ""ヶ"は半角に無い。Chr()関数の繰り返しを避ける為に変数を使う）
（sTempWの追加は、処理能に殆ど影響しないけれど、読み易くなるであろう、と。）
因みに、
　　sTempN = Chr(176)
は、普通に、
　　sTempN = "ー"　　'　　←実際は半角の長音
と書けば済む処なのですが、＃３で説明した通り、
此処のサイトでは、半角カナを投稿出来ないので、代用です。
この手の制約が、提示したコードすべてに、同様に影響しています。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
' ' 文字列を引数に、半角カナだけを全角に置換する関数
' ' 多重置換版＿改
Function KanaJisF(ByVal sSrc As String) As String
Dim sTempW As String
Dim sTempN As String
Dim i As Long
　　' ' 全角カナに相当する文字コードを総当たりでループ
　　For i = -31852 To -31936 Step -1
　　　　sTempW = Chr(i)　'　全角カナ変数に格納
　　　　sTempN = StrConv(sTempW, vbNarrow)　'　半角カナに変換して変数に格納
　　　　' ' 半角カナ各文字が、文字列に含まれている場合、全角カナに置換
　　　　If InStr(1, sSrc, sTempN) Then sSrc = Replace(sSrc, sTempN, sTempW)
　　Next i
　　' ' 半角長音、文字列に含まれている場合、全角長音に置換
　　sTempN = Chr(176)
　　If InStr(sSrc, sTempN) Then sSrc = Replace(sSrc, sTempN, "ー")
　　KanaJisF = sSrc
End Function
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

お礼

ありがとうございました。

回答No.5

real beatin（@realbeatin）

＃３です。

また今回のように、このスレを見て頭悩ます方も居るかも知れませんので、
少し整理しておこうと思います。

文字列処理にの中でも、置換（Replace関数）というのは、
とてもコストの掛かる方法なので、他に方法がない場合以外は
置換を避ける、という前提があります。

なので、ご提示の記述についても、読込んで理解することを端折って、
他の方法を提示したのですが、少しこちらの誤解があったようで、
ロジックとしては成立しているようですね。

直接の回答として、、、以下。

> 多分文字コードの数値だと思うのですが ...
文字コードを間接的に指してしているのは確かですが、
普通は、
　　For i = -31850 To -31936 Step -1
のように書いて、文字コードの補数表現をそのままの形で書きます。
ちょっと捻った書き方になっているので、読む人は困惑しそうですね。

> 「あああ」が全角カタカナになり、「アアアイイイ」になってしまいます。
> ... どう変更すれば、ひらがなは除外されますか？
幾つかの条件で状況は再現できました。
原因が一つであるとすれば、
ご提示のプロシージャが書かれたモジュールが
TextCompare モードになっている場合に起こる現象です。
★Excel VBAの場合は、モジュール先頭に書かれた Option Compare Text を削除。
★その他のアプリケーションでは、モジュール先頭に
　Option Compare Binary
　と１行書き加える（Option Compare * のような記述が他にある場合は削除する）。
　併せて、他のプロシージャにCompareOption設定が影響するなら、
　それらと切り離して、　別のモジュールにプロシージャを分ける。

以上のように対策すれば、'かな'が'カナ'置換されるようなことにはなりません。

今後の為に、、、以下。

●「置換する必要のないものは置換しない」という原則に従って書き加えれば、
　今のままよりも、４割～６割、処理が軽くなります。
●半角長音（カナ）に対する全角置換処理を追加する必要があります。

あらためてベンチに掛けて比較テストなどしてみましたが、
私個人は処理が軽いか標準的なものを好みますから＃３で提示したようなものを使います。
以下、私が奨めるものではないですが、ご提示のやり方を尊重した上で、
ある程度標準的な仕様に整えつつ、関数として書いてみました（今後の為）。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
' ' 文字列を引数に、半角カナだけを全角に置換する関数
' ' 多重置換版
Function KanaJisF(ByVal sSrc As String) As String
Dim sTemp As String
Dim i As Long
　　For i = -31850 To -31936 Step -1　'　全角カナに相当する文字コードを総当たりでループ
　　　　sTemp = StrConv(Chr(i), vbNarrow)　'　全角カナを半角カナに変換したものを変数に格納
　　　　' ' 半角カナ 一文字ずつ、文字列の中に含まれている場合だけ、全角カナに置換する
　　　　If InStr(1, sSrc, sTemp) Then _
　　　　　　sSrc = Replace(sSrc, StrConv(sTemp, vbNarrow), Chr(i))
　　Next i
　　' ' 半角長音、文字列の中に含まれている場合だけ、全角長音に置換する
　　sTemp = Chr(176)
　　If InStr(sSrc, sTemp) Then sSrc = Replace(sSrc, sTemp, "ー")
　　KanaJisF = sSrc
End Function
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

使い方は、
　　str置換前 = StrConv("パパ", vbNarrow) & "(ken:39)の好物は" & StrConv("パパイヤ", vbNarrow)
　　str置換後 = KanaJisF(str置換前)
　　MsgBox str置換前 & vbLf & str置換後

　　str置換前 = StrConv("あああア123イAAAアーカイヴ", vbNarrow)
　　str置換後 = KanaJisF(str置換前)
　　MsgBox str置換前 & vbLf & str置換後
のように。

///
短い記述で済む、というのは、大抵の場合は良いことなのですが、
簡単さ、とか、扱い易さ、とか、解り易さ、とか、メンテし易さ、とか、
処理全体が早く片付けられること、とか、確実さ、とか、
　特に、自分以外の人が見た時、忘れた頃の自分が見た時、
　何をやっている記述なのか、すぐに解るような記述を選ぶとか、
　変わったことをする場合は特に説明コメントを添えておくとか、
　先々困らないようにしておきたい、とか、
まぁ色々な価値基準がありますよね。

たぶん、直接の回答で、解決、ということになるのでしょうけれど、
＃３で提示したものについては、お求めあれば改めて説明を加えます。

以上です。

お礼

ありがとうございました。

回答No.4

kagakusuki

>For i = 31850 To 31936の意味がよくわからないままコピペで使ってしまいました。

　iの値が31850～31936の範囲において、Chr(-i)はヶ～ァの範囲の文字、即ち全ての全角カタカナ文字を返します。
　そしてStrConv関数は、文字列を指定された形式の文字列に変換する関数で、

StrConv(元の文字列, 文字列の形式)

という形式で記述されます。
　文字列の形式の所をvbNarrowにした場合には、(半角文字に変換が可能な文字のみを)半角文字に変換します。
　Replace関数は

Replace(元の文字列,置換対象とする文字列,置換後の文字列)

という形式で記述される関数で、置換対象とする文字列の所にStrConv(Chr(-i), vbNarrow)、即ち半角カタカナ文字が指定されていて、置換後の文字列の所にChr(-i),即ち全角カタカナ文字が指定されている訳ですから、半角カタカナ文字が全角カタカナ文字に変換される訳です。
　尚、半角カタカナ文字には「ガ」や「パ」といった濁音の文字や半濁音の文字が存在せず、「ガ」は「カ」(半角)と「゛」(半角)の2文字に、「パ」も「ハ」(半角)と「゜」(半角)の2文字で表すしかありません。
　そのため、「カ゛ハ゜」という半角文字列を文字コードの番号が小さい-31936から始めて番号が大きな-31850に向かって順番に置換して行ったのでは、文字コード-31926の「カ」の所で「カ(全角)゛(半角)ハ(半角)゜(半角)」に変換されてしまい、次の文字コード-31925の「ガ」の所では「カ(全角)゛(半角)」は「カ(半角)゛(半角)」とは異なるため、「カ(全角)゛(半角)」は「ガ(全角)」には置換されません。
　同様に「ハ(半角)゜(半角)」も「パ(全角)」には置換されず、結局、「カ゛ハ゜」(半角)は「カ゛ハ゜」(全角)に変換されるだけで「ガパ」(全角)にはなりません。
　この問題があるため、文字コードの番号が大きい-31850から始めてコード番号の小さな-31936に向かって置換して行く様にするために、i=31850から31936に向かって処理を進める様にした上で、Chr(-i)という具合に態々マイナスを付けて文字コードを指定している訳です。

　質問者様のVBAで上手く行かなかった理由に関してですが、Replace関数は「平仮名と片仮名を区別して置換する」のか、それとも「区別せずに置換する」のか、という事を選ぶ事が出来る様になっていて、どちらにするのかを指定しなかった場合には(少なくともExcelのバージョンがExcel2010まででは)「平仮名と片仮名を区別して置換する」様になっています。
　それが上手く行かなかったという事は、もしかしますと質問者様のパソコンにおいては、Excelのバージョンの仕様の違い等によって、区別するかしないかを指定しなかった場合には「平仮名と片仮名を区別せずに置換する」様になっているのかも知れません。
　ですから、

str置換後 = Replace(str置換後, StrConv(Chr(-i), vbNarrow), Chr(-i))

の部分を

str置換後 = Replace(str置換後, StrConv(Chr(-i), vbNarrow), Chr(-i), , , vbBinaryCompare)

に変える事で、「全角/半角、大文字/小文字、ひらがな/カタカナを区別する」様にされると良いのではないかと思います。

お礼

ありがとうございました。

回答No.3

real beatin（@realbeatin）

こんにちは。

まず、
このサイトでは半角カナが全角カナに置換されて表示されるので、
以下、半角カナについては、
　　StrConv("カナ", vbNarrow)
のように便宜的に表記します。
実用の場面では、普通に半角の"カナ"と表記するものの代用です。

次に、
半角カナについては、濁点・半濁点も１文字で扱う為、
１文字ずつ取り扱うことは出来ません。
その為、半角カナが連続した部分を、各々塊りごと、処理する必要があって、
その為に様々な工夫があります。
残念ながら、質問文中にご提示のように、各１文字ずつ置換していく方法では、
半角カナを半角カナとして読むことが出来ないのです。

以下、
３例（３つのFunctionと３つのテストSub）挙げておきます。
■１　正規表現版
■２　Midステートメント版
■３　文字列連結・初級版

難易度的には■３が比較的易しいです。
■１は、スキル的に、そろそろ中級というタイミングで、
一応知っておいた方がいいかな、というものです。
正規表現を使ったものでは、モーグさんのものが有名ですが、
ちょっとしたバグがあるので対策したものを示します。
私が提示したテストサンプルのように、
StrConv("パパ", vbNarrow) & "の好物は" & StrConv("パパイヤ", vbNarrow)
部分一致する文字列が後方にある場合に、後方のカナが正しく置換されない、
という問題点を修正しています。
個人的なお奨めは■２です。
変数の数も多いですし、一番難しいですけれど、
メモリ使用量が最少で、処理も速いもの、という意図で書いています。

ご自分の今、に合ったものを見つけるのに参考にしてください。
　Sub test8979427_# ３種　が、テスト用の実行マクロです。
実際に動かして確認してみて下さい。

尚、念の為ですが、下記コードの先頭２行は
モジュール先頭に書かないと、コンパイルエラーで弾かれます。
試す時は、新しい標準モジュールに丸ごとコピペしてから
実行するようにしてみて下さい。

' ' 標準モジュール
' ' ＝＝＝　宣言部　＝＝＝標準モジュール先頭
Option Explicit
Private oRegExp As Object

' ' ■１＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub test8979427_1()
Dim str置換前 As String '置換前の文字列
Dim str置換後 As String '置換後の文字列

　　str置換前 = StrConv("パパ", vbNarrow) & "の好物は" & StrConv("パパイヤ", vbNarrow)

　　str置換後 = KanaJisR(str置換前)

　　MsgBox str置換前 & vbLf & str置換後
End Sub
' ' ■１＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
' ' 文字列を引数に、半角カナだけを全角に置換
' ' 正規表現版
Function KanaJisR(ByVal sSrc As String) As String

　　Dim sBuf As String
　　Dim Matches As Object
　　Dim Match As Object

　　sBuf = sSrc

　　On Error GoTo CrRegExp_
　　Set Matches = oRegExp.Execute(sBuf)
　　On Error GoTo 0

　　For Each Match In Matches
　　　　sBuf = Replace(sBuf, Match, StrConv(Match, vbWide), , 1)
　　Next

　　KanaJisR = sBuf
　　Exit Function

CrRegExp_:
　　Set oRegExp = CreateObject("VBScript.RegExp")
　　oRegExp.Pattern = "[\uFF66-\uFF9F]+"
　　oRegExp.Global = True
　　Resume
End Function
' ' ■１＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

' ' ■２＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub test8979427_2()
Dim str置換前 As String '置換前の文字列
Dim str置換後 As String '置換後の文字列

　　str置換前 = StrConv("パパ", vbNarrow) & "の好物は" & StrConv("パパイヤ", vbNarrow)

　　str置換後 = KanaJisM(str置換前)

　　MsgBox str置換前 & vbLf & str置換後
End Sub
' ' ■２＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
' ' 文字列を引数に、半角カナだけを全角に置換する関数
' ' Midステートメント版
Function KanaJisM(ByVal sSrc As String) As String
　　Dim sBuf As String
　　Dim sPtn As String
　　Dim nLen As Long
　　Dim nPos As Long
　　Dim nSt As Long
　　Dim i As Long
　　Dim flg As Boolean
　　sPtn = "[" & Chr$(166) & "-" & Chr$(223) & "]" '　　"[ヲ-゜]"　　 ←半角カナ
　　nLen = Len(sSrc)
　　sBuf = String$(nLen + 1, vbNullChar)
　　flg = Asc(sSrc) > 165 And Asc(sSrc) < 224
　　nSt = 1
　　nPos = 1
　　For i = 1 To nLen + 1
　　　　If (Mid$(sSrc, i, 1) Like sPtn Xor flg) Or i > nLen Then
　　　　　　If flg Then
　　　　　　　　Mid(sBuf, nPos) = StrConv(Mid$(sSrc, nSt, i - nSt), vbWide)
　　　　　　Else
　　　　　　　　Mid(sBuf, nPos) = Mid$(sSrc, nSt, i - nSt)
　　　　　　End If
　　　　　　flg = Not flg
　　　　　　nSt = i
　　　　　　nPos = InStr(nPos + 1&, sBuf, vbNullChar)
　　　　End If
　　Next i
　　KanaJisM = Left$(sBuf, nPos - 1)
End Function
' ' ■２＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

' ' ■３＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub test8979427_3()
Dim str置換前 As String '置換前の文字列
Dim str置換後 As String '置換後の文字列

　　str置換前 = StrConv("パパ", vbNarrow) & "の好物は" & StrConv("パパイヤ", vbNarrow)

　　str置換後 = KanaJisA(str置換前)

　　MsgBox str置換前 & vbLf & str置換後
End Sub
' ' ■３＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
' ' 文字列を引数に、半角カナだけを全角に置換する関数
' ' 文字列連結・初級版
Function KanaJisA(ByVal sSrc As String) As String
　　Dim sBuf As String
　　Dim nLen As Long
　　Dim nSt As Long
　　Dim i As Long
　　Dim flg As Boolean

　　nLen = Len(sSrc)
　　nSt = 1
　　flg = Asc(sSrc) > 165 And Asc(sSrc) < 224
　　For i = 1 To nLen + 1
　　　　If (Mid$(sSrc, i, 1) Like "[" & Chr$(166) & "-" & Chr$(223) & "]" Xor flg) Or i > nLen Then
　　　　　　If flg Then
　　　　　　　　sBuf = sBuf & StrConv(Mid$(sSrc, nSt, i - nSt), vbWide)
　　　　　　Else
　　　　　　　　sBuf = sBuf & Mid$(sSrc, nSt, i - nSt)
　　　　　　End If
　　　　　　flg = Not flg
　　　　　　nSt = i
　　　　End If
　　Next i

　　KanaJisA = sBuf
End Function
' ' ■３＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

お礼

ありがとうございました。

回答No.2

imogasi

質問のコードの結果不正確の原因を説いた回答ではないが
WEBで見つけて
http://www.atmarkit.co.jp/ait/articles/1406/02/news033.html
エクセルＶＢＡで、エクセルのＡ列に対象文字列（変換前）があるとして
標準モジュールに、上記のＷＥＢ記事通り（多少エクセル向けに変えた）。
下記でテストしてみた。
Option Explicit
Sub 半角カナを含む文字を全角カナに変える()
Dim i As Integer
Dim 文字の長さ1 As Integer
Dim 文字の長さ2 As Integer
Dim 半角のチェック As Integer
Dim r As Long
r = Worksheets("Sheet1").Range("A1000").End(xlUp).Row
MsgBox r
For i = 1 To r
文字の長さ1 = LenB(Cells(i, 1))
文字の長さ2 = LenB(StrConv(Cells(i, 1), vbFromUnicode))
半角のチェック = 文字の長さ1 - 文字の長さ2
If 半角のチェック > 0 Then
Cells(i, 2) = StrConv(Cells(i, 1), vbWide)
Else
Cells(i, 1).Font.ColorIndex = 3
End If
Next i
End Sub
例データ
（A列が変換前、Ｂ列がプログラム実行後文字列）
ヤクシジ　クニヤス ヤクシジ　クニヤス
ナツメ　ダンゴ ナツメ　ダンゴ
マイクロソフト マイクロソフト
エヒメ　ミカン エヒメ　ミカン
ダッソウ　キムコ ダッソウ　キムコ
ダダダダヒーン ダダダダヒーン　（－が半角）
ダダダダヒーン ダダダダヒーン
パンヤバンヤ 　　　（全角のみ）
パンヤバンヤ パンヤバンヤ
゜ ?　　　　　　　　（半濁点のみ）　変換がおかしいようだ。しかし間違い以外はあり得ないだろう例
青いオレンジの皮 青いオレンジの皮
シートデータをコピ-貼り付けすると、変換前の半角もすべて全角に代わちゃった。すみません。
一応上記コードで質問者のデータでテストしてみて、でどうですか。
ーー
着眼点は
全角に変換すると、ＬenＢでの文字列の長さが長くなることを使っている。

お礼

ありがとうございました。

回答No.1

dogs_cats

下記サンプルコードの方が簡単ではないですか？

Sub Sample2()
Dim myStr As String
Dim Match As Object, Matches As Object
Dim CW As String

With CreateObject("VBScript.RegExp")
.Pattern = "[\uFF61-\uFF9F]+" '---(1)
.Global = True

myStr = "あああイイイ"
If Len(myStr) > 0 Then
Set Matches = .Execute(myStr)

'マッチしたすべての文字列を置換
For Each Match In Matches
myStr = Replace(myStr, Match.Value, _
StrConv(Match.Value, vbWide)) '---(2)
Next Match

CW = myStr
End If
End With

Cells(1, 1) = CW
End Sub

下記サイトは使用されてるセル全ての半角カタカナを全角カタカナに変換します。
http://www.moug.net/tech/exvba/0140015.html

お礼

ありがとうございました。