エクセル2003でセル内の文字のうち、半角カナ文字だけを全角かなに変換

質問

エクセル2003でセル内の文字のうち、半角カナ文字だけを全角かなに変換する方法
数字や英文字は半角のまま残して、読みにくい半角カナだけを全角かなに変える方法はあるでしょうか?
JIS（）ですと、すべての文字が全角に変わってしまいます。
詳しい方、どうかよろしくお願い致します。

回答No.8

某HN クロメート(Chromate)（@CoalTar） · ベストアンサー

Wendy02さんの回答を見て、修正してみました。(VBAが読み解けたわけではないですが)
0.1 新しいブックを準備する
0.2 A列に対象となる文字列が入っているものとする
0.3 ツール - オプション |計算方法| 反復計算(100回のまま)
1. C1セル
=IF(B$1="",SUBSTITUTE(SUBSTITUTE(A1,ASC("ー"),"ー"),"ヴ","ヴ"),
IF(OR($E$1>82,$F$1="End"),C1,SUBSTITUTE(C1,ASC(CHAR(9505+$E$1)),CHAR(9505+$E$1))))
※上記数式の最初に出てくる"ヴ"は半角2文字に修正してください
2. D1セル
=IF($F$1="End",SUBSTITUTE(SUBSTITUTE(D1,CHAR(222),CHAR(8491)),CHAR(223),CHAR(8492)),
IF($E$1<=82,C1,SUBSTITUTE(D1,CHAR($E$1+78),JIS(CHAR($E$1+78)))))
3. E1セル
=IF(B$1="",0,IF(E1=88,0,IF(F1="End",0,E1+1)))
4. F1セル =IF(AND(B$1<>"",E1=0),"End","")
5. C1:D1を下へオートフィル
6. B1セルに 何か入力する
D列が求める値なので元のブックへ値を貼り付ける

1.はほとんどのカタカナをASC(CHAR(番号))→CHAR(番号)で全角に置換している
＋特殊な2文字をあらかじめ置換している
2.は特殊な半角記号をCHAR(番号)→JIS(CHAR(番号))で全角に置換している
＋最後の処理として半角濁点と半角半濁点を全角に置換している
3.4.は繰り返し処理、終了処理
6.トリガー(引き金)

お礼

大変参考になりました。　ありがとうございました。　また、このたびはお礼が遅れて申し訳ありませんでした。　今後ともよろしくお願い致します。

回答No.7

mu2011

安直ですが、(1)半角→全角変換→(2)カタカナ→ひらがな変換→(3)全角→半角変換で如何でしょうか。
例として、Ａ１：Ａ５範囲を対象としています。
Sub test()
For Each c In Range("A1:A5")
strwk = StrConv(c, vbWide)
strwk = StrConv(strwk, vbHiragana)
Cells(c.Row, 1) = StrConv(strwk, vbNarrow)
Next
End Sub

お礼

ありがとうございました。　マクロはよくわかりませんので、少しずつ勉強したいと思います。　このたびはお礼が遅れて申し訳ありませんでした。　今後ともよろしくお願い致します。

回答No.6

Wendy02

すでに回答がが出てますが、ご質問者さんのためでなく、単なる問題として回答します。

以下は、単独で、ユーザー定義関数を使っても可能です。

'//標準モジュール
Sub Main()
'上書きスタイル
　　Dim rng As Range
　　Dim rng2 As Range
　　Dim i As Long, c As Variant
　　Dim n As Long, m As Long
　　Set rng = ActiveSheet.UsedRange
　　On Error Resume Next
　　Set rng2 = rng.SpecialCells(xlCellTypeConstants)
　　If Err.Number > 0 Then
　　　　MsgBox "変換する対象セルがありません。", vbExclamation
　　　　Exit Sub
　　End If
　　On Error GoTo 0
　　For Each c In rng2
　　　　n = LenB(StrConv(c.Value, vbFromUnicode))
　　　　c.Value = HalfKana2Full(c.Value)
　　　　m = LenB(StrConv(c.Value, vbFromUnicode))
　　　　If m <> n Then
　　　　i = i + 1
　　　　End If
　　Next
　　If i > 0 Then
　　　　MsgBox i & "個のセルを変換しました。", vbInformation
　　Else
　　　　MsgBox "対象セルは見つかりませんでした。", vbInformation
　　End If
　　Set rng2 = Nothing: Set rng2 = Nothing
End Sub

'//ユーザー定義関数
Public Function HalfKana2Full(ByVal sText As Variant) As String
Dim buf As String
Dim sVal As String
Dim Match As Object
Dim Matches As Object
If VarType(sText) <> vbString Then
　　HalfKana2Full = sText
　　Exit Function
End If
With CreateObject("VBScript.RegExp")
　　.Pattern = "([\uFF61-\uFF9F]+)"
　　.Global = True
　　buf = sText
　　Set Matches = .Execute(buf)
　　For Each Match In Matches
　　　　sVal = .Replace(Match, "$1")
　　　　buf = Replace(buf, sVal, StrConv(sVal, vbWide), , 1, vbBinaryCompare)
　　Next
End With
HalfKana2Full = buf
End Function
'//

同じようなユーザー定義関数が出ていますが、良かったら、見比べてみてください。ここは、回答者にとっても、学習の場だと思いますので、他の方の方法も参考にさせていただきました。なお、定義上の半角カナ文字の範囲というのは、アからでもヲからでもありません。私個人は、もう少し書き加えますが、紙面の都合で省略します。ワードも同じく、文字コードで半角カタカナは記入が可能です。どちらも、Unicode で入力します。

お礼

ありがとうございました。　マクロはよくわかりませんので、少しずつ勉強したいと思います。　このたびはお礼が遅れて申し訳ありませんでした。　今後ともよろしくお願い致します。

回答No.5

jcctaira

VBAでユーザ関数を作成してみました。

=カナ全角(F3) のように使用して下さい。

Function カナ全角(ByVal 文字列)
　Set re = CreateObject("VBScript.RegExp")
　re.Pattern = "[ア-゛]+"
　re.Global = True
　Set MC = re.Execute(文字列)
　For I = 1 To MC.Count
　　文字列 = Replace(文字列, MC(I - 1), StrConv(MC(I - 1), vbWide), , I)
　Next I
　カナ全角 = 文字列
End Function

注）re.Pattern = "[ア-゛]+"
　　ですが、回答文は全角（"[ア-゛]+）になってしまっていますので
　　半角に修正してVBAを作成して下さい。

お礼

ありがとうございました。　マクロはよくわかりませんので、少しずつ勉強したいと思います。　このたびはお礼が遅れて申し訳ありませんでした。　今後ともよろしくお願い致します。

回答No.4

某HN クロメート(Chromate)（@CoalTar）

先ほどの回答に説明不足があったのと改良したので再回答です
A列に 対象があるとします
1. ツール - オプション 計算方法 反復計算にチェック(100回のままで良い)
2. C1セル =IF(B$1="",SUBSTITUTE(SUBSTITUTE(A1,ASC("ー"),"ー"),"ヴ","ヴ"),D1)
3. D1セル =SUBSTITUTE(C1,ASC(CHAR(9505+E1)),CHAR(9505+E1))
4. E1セル =IF(B$1="",0,IF(E1=82,0,IF(F1="End",0,E1+1)))
5. F1セル =IF(AND(B$1<>"",E1=0),"End","")
C1:F1セル範囲を下へオートフィル

ただし、2.の数式の検索対象(先に出てくる"ヴ")は 半角のウと濁点です。
B1セルに値を入れると計算が始まります。答えはD列となります。

回答No.3

某HN クロメート(Chromate)（@CoalTar）

Excelでやってみました。新しいブックで試した方が良いでしょう
A1セルに 対象があるとします
1. ツール - オプション 計算方法 反復計算にチェック
2. C2セル =IF(B$1="",SUBSTITUTE(SUBSTITUTE(A1,ASC("ー"),"ー"),"ヴ","ヴ"),D1)
3. =SUBSTITUTE(C1,ASC(CHAR(9505+E1)),CHAR(9505+E1))
4. =IF(B$1="",0,IF(E1=82,0,E1+1))

2.の数式の検索対象は 半角のウと濁点です。
B1セルに値を入れると計算が始まります。答えはD1セルとなります。

お礼

ありがとうございました。　この方法は知りませんでしたので、やってみようと思います。　このたびはお礼が遅れて申し訳ありませんでした。　今後ともよろしくお願い致します。

回答No.2

MackyNo1

エクセルだけでは半角カタカナだけを全角にすることができませんので、元のエクセルのデータ範囲をワードに貼り付け、ワードの検索機能を利用して変換後、エクセルに貼り付け戻す操作をします。

たとえば、半角の濁音や半濁音を1つの文字にしなくてよいなら以下のような操作になります。

エクセルのデータ範囲を選択し、Ｃｔrl+Cで「コピー」、ワードの新規作成文書にＣｔｒｌ＋Ｖで貼り付けた文書で、Ｃｔｒｌ＋Ｆで検索ダイアログを出し「オプション」ボタンをクリックし「ワイルドカードを使用する」と「見つかった項目を強調表示する」にチェックを入れ、検索する文字列に　[ヲ-゜]　と入力し「すべて検索」します。

該当データを選択した状態で「書式」「文字種の変換」で「全角」にチェックを入れます。

ただし、この方法では半角の濁音や半濁音が２つの文字に分解されてしまいますので、これを避けるには以下のような手順になります。

Ｃｔｒｌ＋Ａですべての文字列を選択し「書式」「文字種の変換」で「全角」にチェックを入れます。

次にＣｔｒｌ＋Ｆからワイルドカード置換で検索する文字列に　[，-ｚ]　と入力し、上記と同様の操作で英数文字のに「半角」に変換します。

最後にこのデータ範囲をＣｔｒl+Cでコピーし、エクセルでＣｔｒｌ＋Ｖで貼り付ければ完成です。

お礼

ありがとうございました。　なるほど、ワードを利用するわけですね!　　目から鱗です。　
このたびはお礼が遅れて申し訳ありませんでした。　今後ともよろしくお願い致します。

回答No.1

noname#138623

データ全体を一度Wordに持っていって変換し、その後またエクセルに戻すのではダメですか？

可能であれば、Word側は

Sub KatakanaHantoZen()
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[ヲ-゜]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Do
Selection.Find.Execute
If Not Selection.Find.Found Then Exit Do
Selection.Range.CharacterWidth = wdWidthFullWidth
Loop
End Sub
あたりのマクロで半角かなを全角かなに一括置換可能ではないかと思いますが…。

お礼

ありがとうございました。　マクロはよくわかりませんので、少しずつ勉強したいと思います。　このたびはお礼が遅れて申し訳ありませんでした。　今後ともよろしくお願い致します。