エクセルでひらがな・漢字はそのままでカタカナを全角・英数字を半角にする方法

エクセル2000を使っています。

会社で住所録作成を引き継ぎましたが、
一つのセルにひらがな、漢字、カタカナ、英数字
が半角・全角ごちゃ混ぜで入っているので
管理がしづらくて困っています。
例えば、

あいうアジアＮＥＴ株式会社
株式会社ABC１２３

などなど・・・・

ひらがな・漢字はそのままで、
カタカナを全角、英数字を半角にする方法は
ありませんか？
最初にASC関数を使ってみたらカタカナも半角になり、
Phonetic関数を使うと、
カタカナだけ全角になりましたが、
ひらがなまでカタカナになり・・・
JIS関数も試しましたが今度は英数字まで全角になり、
どうしたものかと困っております。

よろしくお願いします。

No.4 ベストアンサー 回答者： KenKen_SP 回答日時： 2005/01/06 15:58

No.2です。

遅くなりました。修正コード、、というより別物ですがアップします。

実は、以前に類似した質問に回答したことがあります。（参考URL）
今回はBLUEPIXYのコードも参考にさせてもらい、その時のコードに手を加えました。
関数myStrFmtはワークシートでも使えますし、他のプロシージャーでも使えます。

どうでしょうか？

========== 次行からコード ==================================

'***************************************************************
'　カタカナは全角化、英数字および記号を半角化するユーザー定義関数
'　引数：文字列　変換対象となる文字列を指定します
'　引数：数字　　数字半角化オプション（省略可） 規定値：True
'　引数：記号　　記号半角化オプション（省略可） 規定値：False
'***************************************************************
Function myStrFmt(文字列 As String, Optional 数字 As Boolean = True, Optional 記号 As Boolean = False)

　　Dim ReplaceList As String
　　Dim TargetStr As String
　　Dim MAK As String, NUM As String, ALB As String
　　Dim i As Long

　　'半角化の対象とする文字を全角で定義
　　MAK = "！＃＄％＆＇（）＊＋－．／：；＜＝＞？＠［￥］＾＿｛｜｝。、，,"
　　NUM = "０１２３４５６７８９０"
　　ALB = "ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ"
　　'置換リスト作成
　　ReplaceList = NUM & ALB & StrConv(ALB, vbLowerCase)
　　If 数字 Then ReplaceList = ReplaceList & NUM
　　If 記号 Then ReplaceList = ReplaceList & MAK

　　'全角化
　　文字列 = StrConv(文字列, vbWide)
　　'置換
　　For i = 1 To Len(ReplaceList)
　　　　TargetStr = Mid(ReplaceList, i, 1)
　　　　文字列 = Replace(文字列, TargetStr, StrConv(TargetStr, vbNarrow))
　　Next i
　　myStrFmt = 文字列

End Function

'マクロで関数を使用するサンプル（セルを選択した状態で実行）
Sub サンプル()

　　On Error Resume Next
　　Dim rngCell As Range
　　Application.ScreenUpdating = False
　　For Each rngCell In Selection
　　　　If rngCell.Value <> "" Then
　　　　　　rngCell.Value = myStrFmt(rngCell.Value, True, False)
　　　　End If
　　Next rngCell
　　Application.ScreenUpdating = True

End Sub

参考URL：http://oshiete1.goo.ne.jp/kotaeru.php3?q=1100627

この回答へのお礼

ありがとうございました！
今度は問題なく全て変換されました。
過去にお答えになったという質問も
読ませていただきました。
過去の質問も一応は
チェックしましたが、完全に見落としておりまして、
恥ずかしい限りです。
問題もおかげで解決し、
本当にありがとうございました。

お礼日時：2005/01/06 18:22

No.3 回答者： KenKen_SP 回答日時： 2005/01/06 12:40

No.2です。

＞なぜかportという単語が　ppsu　になったり、

申し訳ないです。関数で変換部分がマズかったです。私が関数のコードを作成したPCではOKだったのですが、ほかのPCでは、誤置換されてしまいました。

修正コードをアップしますので、少々お待ちいただけたら幸いです。

この回答へのお礼

お手数をおかけします。
よろしくお願いいたします。

お礼日時：2005/01/06 14:53

No.2 回答者： KenKen_SP 回答日時： 2005/01/05 22:28

こんにちは。

一般操作による方法が思い付きません。ユーザー定義関数にしてみました。したがって、ワークシートで使用することも、マクロで使用することも可能です。

1.　ワークシートで使用する場合

A1セル：変換対象となるデータ　B1セル：＝myStrFmt(A1)
ASC関数などと同じように使用します。

2.　マクロで使用する場合

サンプルマクロを示します。セルを範囲選択し、実行すると漢字・ひらがな・カタカナは全角、英数字は半角に統一します。

ただし、あまり効率的なやり方では無いような気がしてます。置換をゴリゴリやっているだけですから。でも、以下の環境で10,000件のテストデータ変換に1分程度ですから、実用には耐えるのではないでしょうか？

CPU:C400 Memory:256M Win98SE Excel2000

========== 次行からコード ==================================

'ユーザー定義関数（ワークシートで使えます）
'文字列中のひらがな・カタカナを全角、英数字を半角にします。
Function myStrFmt(Target As String) As String

　　Target = StrConv(Target, vbWide)
　　'全角アルファベット置換
　　For i = -32160 To -32135
　　　　Target = Replace(Target, Chr(i), Chr(i + 32225))
　　　　Target = Replace(Target, Chr(i + 32), Chr(i + 32 + 32225))
　　Next i
　　'全角数字置換
　　For i = -32177 To -32168
　　　　Target = Replace(Target, Chr(i), Chr(i + 32225))
　　Next i
　　myStrFmt = Target

End Function


'マクロで関数を使用するサンプル（セルを選択した状態で実行）
Sub サンプル()

　　On Error Resume Next
　　Dim rngCell As Range
　　Application.ScreenUpdating = False
　　For Each rngCell In Selection
　　　　If rngCell.Value <> "" Then
　　　　　　rngCell.Value = myStrFmt(rngCell.Value)
　　　　End If
　　Next rngCell
　　Application.ScreenUpdating = True

End Sub

この回答への補足

丁寧に教えていただき、ありがとうございました。
教えていただいたとおりにやったつもりなのですが、
なぜかportという単語が　ppsu　になったり、
e が　f になってしまいました。
全てのportが　ppsuに、eがfになるわけではないので、
もともとのデータの入力時になにか問題があったのかしら？　と思います。
また、最初に触れませんでしたが、「・」も
リスト中にあり、それは全て「a」に変換されました。
頂いた関数を見ればなにかわかるかな・・・
と思いましたが、なにぶん、マクロ・関数は（も）
初心者でよくわかりませんでした・・・。
何か思いつくことがございましたら、
今一度ご教授いただけますでしょうか。
よろしくお願いいたします。

補足日時：2005/01/06 10:16

No.1 回答者： BLUEPIXY 回答日時： 2005/01/05 22:25

拙作のユーザー定義関数で指定した文字を置き換えることができます。

変換が必要なセルをA1だとして
いったん全角に変換してから英数字を半角に置き換えるという方針で
=tr(JIS(A1),"ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ＠＋－．０１２３４５６７８９","ABCDEFGHIJKLMNOPQRSTUVWXYZ@+-.0123456789")
みたいな、感じで置き換えたい文字の種類を書きます。お好みで英記号を追加して下さい。

ALT+F11でＶＢＥにて標準モジュールで以下を貼り付けて使用して下さい。
Public Function tr(str As String, replaceList As String, convertList) As String
Dim i, c
For i = 1 To Len(replaceList)
str = Replace(str, Mid(replaceList, i, 1), Mid(convertList, i, 1))
Next
tr = str
End Function

この回答へのお礼

ご教授ありがとうございました。
コピペでやってみたら解決しました！
ユーザー定義関数などは
利用したことがなかったので、
これから教えていただいた関数の中身を
理解したいと思います！
本当にありがとうございました。

お礼日時：2005/01/06 09:54