HOME > Q&A > Excel （VBA）

Excel （VBA）
Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11 Home : Excel 2021)
ひらがなやカタカナは全角のままで英数字のみ半角
投稿日時: 25/11/06 00:40:09
投稿者: バルバロッサ

お世話になります。
各セル内に長さがまちまちの文章が1文ずつ入っています（例えばA列200行）
その文章は漢字やカタカナやひらがな，さらには英数字で構成されています。
しかし，文章の中には英数字が全角になっているところがあります。
 
そろえるために，
漢字，ひらがな，カタカナは全角のまま
英数字のみ半角
に変換したいと思っています。
 
エクセル関数でASC関数を使うと英数字だけではなくカタカナも半角になっています。
そこでその後に，PHONETIC関数と使うとカタカナは全角になるのですが，ひらがながカタカナに変わってしまいます。
エクセル関数では限界があるので，VBAでマクロを作成したいのですが，どうやって良いのか検討がつきません。
お教えください。
よろしくお願い申し上げます。

回答
投稿日時: 25/11/06 10:25:09
投稿者: Suzu

「変換」が、関数を使わないで、元データを置換を使って書き換えても良いなら
https://learn.microsoft.com/ja-jp/answers/questions/4769654/question-4769654
 
あくまで一般関数なのであれば
https://www.officeisyours.com/entry/2022/04/05/060000
 
VBAを使っても良いのですが・・
 
例えば 

Public Function convNarrow(c As Variant) As String
  Dim chara As String
  Dim strRet As String
  Dim i As Long

  For i = 1 To Len(c)
    chara = Mid(c, i, 1)
    Select Case AscW(chara)
      Case -240 To -231 '０-９  &HFF10 - &HFF19
       strRet = strRet & ChrW(AscW(chara) + 288)
      Case -223 To -198 'Ａ - Ｚ  &HFF21 - &HFF3A
       strRet = strRet & ChrW(AscW(chara) + 288)
      Case -191 To -166 'ａ - ｚ  &HFF41 - &HFF5A
       strRet = strRet & ChrW(AscW(chara) + 288)
      Case Else
       strRet = strRet & chara
    End Select
  Next
  convNarrow = strRet
End Function

 
しかしながら、今回の様に「漢字」が含まれていて
そこに、高橋 の はしごだか や、吉田 の 下が長いつちよし の様に
IME変換時に≪機種依存文字≫ と表示される文字が含まれると 上記では対応できません。
　LENや、MID の 文字長さを求め、対象文字を参照する部分で問題が発生します。
　サロゲートペアと呼ばれる、文字コード 2文字分 のコードを使い 1文字分を表示させる文字に
　LEN・MID では対応できず、自作のLENやMID関数を準備する必要があります。
 
特殊文字が含まれる可能性があるなら、一般機能にて対応した方が無難です。
 
 
PHONETIC関数 は フリガナ を表記させる関数。
漢字が含まれているのですから、その漢字 フリガナ に変わってはダメなのでは？
そもそも、漢字・ひらがな が含まれるなら、PHONETIC関数 は 不適切でしょう。
回答
投稿日時: 25/11/06 15:59:48
投稿者: 紙頼

A1に文字列がある場合
以下の関数でできると思います。
 
=CONCAT(IF((CODE(MID(A1,SEQUENCE(1,LEN(A1)),1))<9082)*(CODE(MID(A1,SEQUENCE(1,LEN(A1)),1)>9008)),ASC(MID(A1,SEQUENCE(1,LEN(A1)),1)),MID(A1,SEQUENCE(1,LEN(A1)),1)))
 
VBAを使用する場合は、英数字分「置き換え」を並べるのが簡単（分かりやすい）かと思います。
回答
投稿日時: 25/11/06 16:23:09
投稿者: 紙頼

すみません。
関数では、半角にしてしまう記号があるようでした。
 
ＶＢＡが簡単なようです。
回答
投稿日時: 25/11/06 16:32:29
投稿者: 紙頼

必要な文字数分下のVBAを並べて、
シートで必要な範囲を選択して実行するのが安易で楽。
 
好きな文字・記号で行けます。
 
Selection.Replace What:="０", Replacement:="0"
Selection.Replace What:="１", Replacement:="1"
回答
投稿日時: 25/11/07 09:53:56
投稿者: 紙頼

度々すみません。
 
これなら関数でいけるかも。
 
=CONCAT(IF((CODE(MID(A1,SEQUENCE(1,LEN(A1)),1))<9083)*(CODE(MID(A1,SEQUENCE(1,LEN(A1)),1))>9007),ASC(MID(A1,SEQUENCE(1,LEN(A1)),1)),MID(A1,SEQUENCE(1,LEN(A1)),1)))
回答
投稿日時: 25/11/07 10:25:52
投稿者: 半平太

紙頼さん 

＞投稿日時: 25/11/06 15:59:48
＞=CONCAT(・・<9082)*(CODE(MID(A1,SEQUENCE(1,LEN(A1)),1)>9008)),ASC・・
　=CONCAT(・・<9082)*(CODE(MID(A1,SEQUENCE(1,LEN(A1)),1))>9008),ASC・・
　　　　　　　     　　　　　　　　　　　　　　　　　　↑　　↑
じゃないですか？

回答
投稿日時: 25/11/07 14:42:51
投稿者: 紙頼

このVBAが簡単で分かりやすく
変更により、文字種の拡張や元に戻す操作用等
すぐに作れると思います。
 
対象のセル範囲を選択して
マクロ実行
 
Sub 英数字半角()
 
'数字
Selection.Replace What:="０", Replacement:="0"
Selection.Replace What:="１", Replacement:="1"
Selection.Replace What:="２", Replacement:="2"
Selection.Replace What:="３", Replacement:="3"
Selection.Replace What:="４", Replacement:="4"
Selection.Replace What:="５", Replacement:="5"
Selection.Replace What:="６", Replacement:="6"
Selection.Replace What:="７", Replacement:="7"
Selection.Replace What:="８", Replacement:="8"
Selection.Replace What:="９", Replacement:="9"
 
'アルファベット大文字
Selection.Replace What:="Ａ", Replacement:="A"
Selection.Replace What:="Ｂ", Replacement:="B"
Selection.Replace What:="Ｃ", Replacement:="C"
Selection.Replace What:="Ｄ", Replacement:="D"
Selection.Replace What:="Ｅ", Replacement:="E"
Selection.Replace What:="Ｆ", Replacement:="F"
Selection.Replace What:="Ｇ", Replacement:="G"
Selection.Replace What:="Ｈ", Replacement:="H"
Selection.Replace What:="Ｉ", Replacement:="I"
Selection.Replace What:="Ｊ", Replacement:="J"
Selection.Replace What:="Ｋ", Replacement:="K"
Selection.Replace What:="Ｌ", Replacement:="L"
Selection.Replace What:="Ｍ", Replacement:="M"
Selection.Replace What:="Ｎ", Replacement:="N"
Selection.Replace What:="Ｏ", Replacement:="O"
Selection.Replace What:="Ｐ", Replacement:="P"
Selection.Replace What:="Ｑ", Replacement:="Q"
Selection.Replace What:="Ｒ", Replacement:="R"
Selection.Replace What:="Ｓ", Replacement:="S"
Selection.Replace What:="Ｔ", Replacement:="T"
Selection.Replace What:="Ｕ", Replacement:="U"
Selection.Replace What:="Ｖ", Replacement:="V"
Selection.Replace What:="Ｗ", Replacement:="W"
Selection.Replace What:="Ｘ", Replacement:="X"
Selection.Replace What:="Ｙ", Replacement:="Y"
Selection.Replace What:="Ｚ", Replacement:="Z"
 
'アルファベット小文字
Selection.Replace What:="ａ", Replacement:="a"
Selection.Replace What:="ｂ", Replacement:="b"
Selection.Replace What:="ｃ", Replacement:="c"
Selection.Replace What:="ｄ", Replacement:="d"
Selection.Replace What:="ｅ", Replacement:="e"
Selection.Replace What:="ｆ", Replacement:="f"
Selection.Replace What:="ｇ", Replacement:="g"
Selection.Replace What:="ｈ", Replacement:="h"
Selection.Replace What:="ｉ", Replacement:="i"
Selection.Replace What:="ｊ", Replacement:="j"
Selection.Replace What:="ｋ", Replacement:="k"
Selection.Replace What:="ｌ", Replacement:="l"
Selection.Replace What:="ｍ", Replacement:="m"
Selection.Replace What:="ｎ", Replacement:="n"
Selection.Replace What:="ｏ", Replacement:="o"
Selection.Replace What:="ｐ", Replacement:="p"
Selection.Replace What:="ｑ", Replacement:="q"
Selection.Replace What:="ｒ", Replacement:="r"
Selection.Replace What:="ｓ", Replacement:="s"
Selection.Replace What:="ｔ", Replacement:="t"
Selection.Replace What:="ｕ", Replacement:="u"
Selection.Replace What:="ｖ", Replacement:="v"
Selection.Replace What:="ｗ", Replacement:="w"
Selection.Replace What:="ｘ", Replacement:="x"
Selection.Replace What:="ｙ", Replacement:="y"
Selection.Replace What:="ｚ", Replacement:="z"
 
End Sub

回答
投稿日時: 25/11/07 15:01:46
投稿者: 紙頼

半平太さん
 
ありがとうございます。
後で気づきました。
 
ご指摘の通り
カッコの位置を間違えていました。
回答
投稿日時: 25/11/07 15:58:10
投稿者: 紙頼

ほんとうに度々すみません。
大文字と小文字を区別するには
以下のようです。
 
ひねりのない方法ですみません。
 
Sub 英数字半角2()
 
'数字
Selection.Replace What:="０", Replacement:="0"
Selection.Replace What:="１", Replacement:="1"
Selection.Replace What:="２", Replacement:="2"
Selection.Replace What:="３", Replacement:="3"
Selection.Replace What:="４", Replacement:="4"
Selection.Replace What:="５", Replacement:="5"
Selection.Replace What:="６", Replacement:="6"
Selection.Replace What:="７", Replacement:="7"
Selection.Replace What:="８", Replacement:="8"
Selection.Replace What:="９", Replacement:="9"
 
'アルファベット大文字
Selection.Replace What:="Ａ", Replacement:="A", MatchCase:=True
Selection.Replace What:="Ｂ", Replacement:="B", MatchCase:=True
Selection.Replace What:="Ｃ", Replacement:="C", MatchCase:=True
Selection.Replace What:="Ｄ", Replacement:="D", MatchCase:=True
Selection.Replace What:="Ｅ", Replacement:="E", MatchCase:=True
Selection.Replace What:="Ｆ", Replacement:="F", MatchCase:=True
Selection.Replace What:="Ｇ", Replacement:="G", MatchCase:=True
Selection.Replace What:="Ｈ", Replacement:="H", MatchCase:=True
Selection.Replace What:="Ｉ", Replacement:="I", MatchCase:=True
Selection.Replace What:="Ｊ", Replacement:="J", MatchCase:=True
Selection.Replace What:="Ｋ", Replacement:="K", MatchCase:=True
Selection.Replace What:="Ｌ", Replacement:="L", MatchCase:=True
Selection.Replace What:="Ｍ", Replacement:="M", MatchCase:=True
Selection.Replace What:="Ｎ", Replacement:="N", MatchCase:=True
Selection.Replace What:="Ｏ", Replacement:="O", MatchCase:=True
Selection.Replace What:="Ｐ", Replacement:="P", MatchCase:=True
Selection.Replace What:="Ｑ", Replacement:="Q", MatchCase:=True
Selection.Replace What:="Ｒ", Replacement:="R", MatchCase:=True
Selection.Replace What:="Ｓ", Replacement:="S", MatchCase:=True
Selection.Replace What:="Ｔ", Replacement:="T", MatchCase:=True
Selection.Replace What:="Ｕ", Replacement:="U", MatchCase:=True
Selection.Replace What:="Ｖ", Replacement:="V", MatchCase:=True
Selection.Replace What:="Ｗ", Replacement:="W", MatchCase:=True
Selection.Replace What:="Ｘ", Replacement:="X", MatchCase:=True
Selection.Replace What:="Ｙ", Replacement:="Y", MatchCase:=True
Selection.Replace What:="Ｚ", Replacement:="Z", MatchCase:=True
 
'アルファベット小文字
Selection.Replace What:="ａ", Replacement:="a", MatchCase:=True
Selection.Replace What:="ｂ", Replacement:="b", MatchCase:=True
Selection.Replace What:="ｃ", Replacement:="c", MatchCase:=True
Selection.Replace What:="ｄ", Replacement:="d", MatchCase:=True
Selection.Replace What:="ｅ", Replacement:="e", MatchCase:=True
Selection.Replace What:="ｆ", Replacement:="f", MatchCase:=True
Selection.Replace What:="ｇ", Replacement:="g", MatchCase:=True
Selection.Replace What:="ｈ", Replacement:="h", MatchCase:=True
Selection.Replace What:="ｉ", Replacement:="i", MatchCase:=True
Selection.Replace What:="ｊ", Replacement:="j", MatchCase:=True
Selection.Replace What:="ｋ", Replacement:="k", MatchCase:=True
Selection.Replace What:="ｌ", Replacement:="l", MatchCase:=True
Selection.Replace What:="ｍ", Replacement:="m", MatchCase:=True
Selection.Replace What:="ｎ", Replacement:="n", MatchCase:=True
Selection.Replace What:="ｏ", Replacement:="o", MatchCase:=True
Selection.Replace What:="ｐ", Replacement:="p", MatchCase:=True
Selection.Replace What:="ｑ", Replacement:="q", MatchCase:=True
Selection.Replace What:="ｒ", Replacement:="r", MatchCase:=True
Selection.Replace What:="ｓ", Replacement:="s", MatchCase:=True
Selection.Replace What:="ｔ", Replacement:="t", MatchCase:=True
Selection.Replace What:="ｕ", Replacement:="u", MatchCase:=True
Selection.Replace What:="ｖ", Replacement:="v", MatchCase:=True
Selection.Replace What:="ｗ", Replacement:="w", MatchCase:=True
Selection.Replace What:="ｘ", Replacement:="x", MatchCase:=True
Selection.Replace What:="ｙ", Replacement:="y", MatchCase:=True
Selection.Replace What:="ｚ", Replacement:="z", MatchCase:=True
 
End Sub
 
でも
投稿日時: 25/11/07 09:53:5の
関数が良いかも
 
 
投稿日時: 25/11/07 09:53:5

回答
投稿日時: 25/11/07 16:20:31
投稿者: gombohori

変換テーブルを用意してもいいかもしれませんね 

Function Henkan(str As String) As String
   Dim s As String, ret As String
   For i = 1 To Len(str)
      s = Mid(str, i, 1)
      ret = ret & WorksheetFunction.XLookup(s, Range("変換テーブル[Befor]"), Range("変換テーブル[After]"), s, 0)
   Next
   Henkan = ret
End Function

回答
投稿日時: 25/11/07 18:51:05
投稿者: んなっと

　　　　　　　　　　　　　　　　　　A　　　　　　　　　　　　B
1　１２３９０カキクＡＢＣｘｙｚあいう　12390カキクABCxyzあいう
 
B1
=LET(a,MID(A1,SEQUENCE(LEN(A1)),1),b,IF(ABS(CODE(a)-9045)<=37,ASC(a),a),CONCAT(b))
下方向・↓

投稿日時: 25/11/09 01:28:05
投稿者: バルバロッサ

たくさんの皆様，本当にありがとうございました。
一番わかりやすかったのは，紙頼さまの最後のコードが正直単純でわかりやすかったです。
一応，無事に処理できました。
大変お世話になりました。
 
今後とも何卒よろしくお願いいたします。