読み飛ばしてもらってもいいと思う

そんなのはもうあるんだよ

需要があるからそんなモンはすでに巷に溢れかえってるんですよね。
わざわざここであらためて出すようなものじゃないでしょ、と言われそうではありますが、それらの方法やコードでは解決できない問題が出現しました。

それが「Unicode特有の文字を扱えない」という限定的ではあるものの重要な問題です。逆を言えばそのようなリスクがない現場では不要ということでもあります。
※ここではこの文字のことを「Unicode文字」と呼ぶことにします。

VBEくんはちょっとアホなので、Shift-JISに含まれない文字をよく知りません。
なので「㎥（立方メートル）」とか「💪(・ω・｀)💪」とか入れられると、変数への代入やそのままの出力こそできるものの、文字列関数で全角だ半角だとやってると突然

と反抗的な態度に出ます。生意気な。

ためしに以下の文字列をコピーして、皆さんが作った（あるいはどこかからコピペしてきた）変換マクロにブッ込んで実行してみてください。

もちろん理想としては

となってほしいんですが、いかがだったでしょう。
まずイミディエイトウィンドウに貼り付けられない。
何度やっても㉑が?になってしまう。
それならセルに貼り付けてそれを読めばいいじゃないかと試みるも、今度は㉑が？に化けて出てくるとか、まぁ大方そんなところじゃないかなと思います。

一応「アタマから一文字ずつ判定する」って手も一度は考えたんですが、半角カタカナの濁点半濁点で破綻することが予想できたのでやめました。

Unicode文字のケアをしていない野良コードしか見当たらねぇ！
という思いからこの野良記事は生まれています。

一応解説します

smartConverterプロシージャ

求：スマートの定義

今回の主目的を達成するためのFunctionプロシージャです。
基本的にはこれを呼び出せばOK。

大まかには「一括で全角文字にしてから指定文字を半角にする」という方針ですが、その前にUnicode文字の有無で処理を分けています。
Unicode文字を含む文字列の場合、その文字より後ろ部分だけを再帰させることで複数回出現した場合にも対応しています。

Public Function smartConverter(ByVal strOriginal As String) As String
  
  Dim strTemp      As String  '一時作業用文字列
  Dim numPos       As Long    'カーソル位置
  Dim numCode      As Long    'Unicode文字コード

  '文字列がUnicode文字を含むかどうか
  If hasUnicode(strOriginal, numPos, numCode) Then
    
    '* Unicode文字を含む場合
    'hasUnicodeの引数経由でUnicode文字の位置とその文字コードを取得している

    'Unicode文字より前の部分を全角に変換する
    strTemp = StrConv(Left(strOriginal, numPos - 1), vbWide)

    'その部分の英数字は半角に変換する
    strTemp = narrowAlphabet(strTemp)

    'Unicode文字を単独で連結し、それより後ろの文字列を再帰させる
    strTemp = strTemp & ChrW(numCode) & smartConverter(Mid(strOriginal, numPos + 1))
  
  Else

    '* Unicode文字を含まない場合

    '文字列全体を全角に変換する
    strTemp = StrConv(strOriginal, vbWide)

    '英数字を半角に変換する
    strTemp = narrowAlphabet(strTemp)

  End If

  '戻り値
  smartConverter = strTemp

End Function

hasUnicodeプロシージャ

文字列がUnicode文字を含むか否かを判定し、Boolean型で返します。
必要であればその位置と文字コードを引数経由で取得することもできます。

細かいことは省きますが、VBAはUnicode文字をすべて半角の「?」で扱います。
しかしそれは見た目だけで、文字コードは内部に保持しているためChrW関数で復元が可能です。
これを全角に変換してしまうと本当の全角「？」になってしまい、二度と戻せなくなってしまいます。当然本物の「？」と区別も付きません。

そこでsmartConverterプロシージャ内で復元するために、文字コードを取得しておく必要があるんですね。

Public Function hasUnicode(ByVal strOriginal As String, Optional ByRef cntPos As Long, Optional ByRef numCode as Long) As Boolean
  
  Dim strQuestion     As String    '"?"の文字そのもの
  Dim strChar         As String    '文字列から抜き出した1文字

  '戻り値初期化
  hasUnicode = False

  '半角の"?"ではあるが紛らわしいため、同値のChr(63)で初期化
  strQuestion = Chr(63)

  '引数として1未満を渡されるとエラーとなるため初期化
  If cntPos < 1 Then cntPos = 1

  'Unicode文字はVBAで処理する場合"?"に見えてしまうことを利用する
  '"?"　Shift-JISコード、Unicodeコードともに63
  'Unicode文字　Shift-JISコード：63、Unicodeコード：63ではない
  '※全角に変換すると本当の全角"？"になってしまい、復元できなくなる点に注意
  
  'ループ
  Do

    'カウンター変数が文字数より大きくなったら抜ける
    If cntPos > Len(strOriginal) Then Exit Do

    '1文字取得
    strChar = Mid(strOriginal, cntPos, 1)

    '文字のShift-JISコードが同じ場合
    if Asc(strChar) = Asc(strQuestion) Then
       With WorksheetFunction
          
        '文字コードが異なる場合
        If Not .Unicode(strChar) = .Unicode(strQuestion) Then

          '戻り値はTrueに
          hasUnicode = True

          '文字の位置（自明なので書かなくていいけど）
          'cntPos = cntPos

          '文字コード
          numCode = .Unicode(strChar)

          '処理を抜ける
          Exit Function

        End If

      End With

    End If

    '次の文字へ
    cntPos = cntPos + 1

  Loop

End Function

narrowAlphabetプロシージャ

英数字のみ半角にして返します。

実際には、1文字ずつ判定して指定した文字が出てきたら変換する、を繰り返しているだけなので、個別の文字にも対応できるのが強みです。
ここではハイフン罫線ダッシュ問題（たった今名付けた）を片付けてみました。

Public Function narrowAlphabet(ByVal strOriginal As String) As String

  Dim strTemp      As String    '作業用文字列
  Dim cntChar      As Long      'カウンタ
  Dim strChar      As String    '1文字

  '初期化
  strTemp = vbNullString

  '文字数でループ
  For cntChar = 1 To Len(strOriginal)

    '1文字取得
    strChar = Mid(strOriginal, cntChar, 1)

    Select Case True
      '半角にしたい文字や記号があればここに追記する
      Case isMatch(strChar, "[０-９Ａ-Ｚａ-ｚ，．／]")

        '半角文字に変換
        strChar = StrConv(strChar, vbNarrow)

      'ハイフンっぽい文字を半角ハイフンに統一
      Case isMatch(strChar, "[―─－]")

        'ハイフンに変換
        strChar = "-"

    End Select

    '文字列に連結する
    strTemp = strTemp & strChar
  
  Next cntChar

  '戻り値
  narrowAlphabet = strTemp

End Function

isMatchプロシージャ

正規表現でマッチした場合にTrueを返すプロシージャです。

Object宣言してうんぬん…がいつも面倒なので、これはライブラリ化して手軽に呼び出せるようにしています。
なので私自身、このロジックやらお作法やらは一切覚えていません。
なぜか正規表現周りの記述が苦手なんですよね。
脳に覚えるリソースがないとも言いますが。

参照設定せずにわざわざ呼び出し（実行時バインディング）をしているのは、配布ファイルになっ（てしまっ）た際の手間をなくすためです。
ほら、「これ動かないんだけどー？」で呼ばれるの、面倒でしょ？

Public Function isMatch(ByVal strMatching As String, ByVal strPattern As String) As Boolean

  Dim objReg    As Object
  Set objReg = CreateObject("VBScript.RegExp")

  objReg.Pattern = strPattern

  isMatch = objReg.Test(strMatching)

End Function

まとめ

完走した感想ですが

当初は本当にスパゲッティでとにかく縦に長く、翌日自分のコードを見てワケがわからない状態になりました。
また、公開ブックにすることが前提だったこともあり「イカンでしょ」となった経緯があります。

そんなこんなで一度組んだロジックをすべてひっくり返し、イチから組み直したにしてはだいぶシンプルにまとまったのかな、とは思っています。

それぞれのプロシージャも他で使えるかもしれないのでPublicにしておきましたが、isMatch以外は出番はなさそうですね。