丸付き数字から丸囲み数字（丸数字）に変換
〔プログラムな？話〕 13:17 No Comment ツイート
洋々亭にて、様々なVBAコードが公開されている。
この中に含まれている、丸付き数字（「○２」など）を丸囲み数字（「②」など）に変換する関数を、⓪～㊿まで対応できるように改造した。
ちなみになんでこんな関数が必要かというと、一部の法令（児童福祉法など）は、項番号の代わりに丸数字を使用していることがあるが、丸数字は機種依存文字（環境依存文字）なので正しく表示されないコンピュータが存在する恐れがあり、e-Govでは「○２」としている。これを本来意図するところの丸数字に置き換えるため。
現在ではほとんどの機種（環境）で丸数字が表示できるようになっており、これを一括変換したいという要望があったので、洋々亭のコードを拝借し、かつ範囲を広げた。
'---------------------------------------------------------------------------------------------------
' 丸付き数字置換関数
' ◆機能の説明
' ・「○３」形式の表記を「③」に変換する
' ・一部文字列はUnicode文字に変換する
' ・一定数を超える数字の場合は丸囲み数字が使用できないため、角かっこで囲む（○５１→[51]）
' ※項番号を上記の方法で表記している法令があるための対処（児童福祉法等）。
' オリジナル：洋々亭 2006
'---------------------------------------------------------------------------------------------------
Private Function ToCircledNum(ByRef srcStr As String) As String
Dim srcLen As Long '引数の文字列長（○を含む）
Dim tmpAsc As String '引数から○を除去し半角英数に変換した文字列
Dim chrNum As Long '変換後の数字
Dim i As Long 'イテレータ
'まず全角数字を半角数字に置き換え、次に半角数字を丸数字に置き換える。
Let srcLen = Len(srcStr)
If srcLen < 2 Then
Exit Function
End If
Let tmpAsc = String$(srcLen - 1, vbNullChar)
For i = 2 To srcLen
Mid(tmpAsc, i - 1, 1) = Mid$("0123456789", CLng(InStr("０１２３４５６７８９", Mid$(srcStr, i, 1))), 1)
Next i
Let chrNum = CLng(tmpAsc)
Select Case chrNum
Case Is < 0 '0未満は非対応([]で括る)
Let ToCircledNum = "[" & tmpAsc & "]"
Case 0 '丸0 = U+24EA( 9450) chrNum=0のためそのまま
Let ToCircledNum = ChrW(9450)
Case Is < 21 '1～20は普通に丸囲み数字が使用できる
Let ToCircledNum = Mid$("①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳", chrNum, 1)
Case Is < 36 '丸21 = U+3251(12881) 21から始まるため 12881 - 21 = 12860
Let ToCircledNum = ChrW(12860 + chrNum)
Case Is < 51 '丸36 = U+32B1(12977) 36から始まるため 12977 - 36 = 12941
Let ToCircledNum = ChrW(12941 + chrNum)
Case Else '51以上も非対応([]で括る)
Let ToCircledNum = "[" & tmpAsc & "]"
End Select
End Function
「引数には丸記号＋全角英数字の組み合わせの文字列しか来ない」という前提で作ってる関数なので、呼び出し前に正規表現やLikeマッチングでのふるい落としが必要。簡単な判定は19行目でやってるけど（引数が1文字以下なら何も返さず終了）。
やってることは洋々亭のmarumoji関数と一緒。まず全角英数字を半角英数字に置き換え（22～25行目）、整数型に変換（26行目）。あとはSelect Case文で0未満と50超は対応する丸数字がないため[]で括る、⓪と㉑～㊿はChrW関数で文字コードから文字を取得。①～⑳は文字を並べてMid関数で対応する数字の位置に該当する文字を取得。
①～⑳もChr関数を使えば取得できるが、文字を並べてMid関数で取得した方がちょっとだけ早い。
Public Sub SpeedTest()
Dim testNums(2000000) As Long
Dim dummyStr As String
Dim procTime As Single
Dim i As Long
For i = LBound(testNums) To UBound(testNums)
Let testNums(i) = RandomLong(1, 20)
Next i
Let procTime = Timer
For i = LBound(testNums) To UBound(testNums)
Let dummyStr = Mid$("①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳", testNums(i), 1)
Next i
Debug.Print "Test1: " & Timer - procTime 'Test1: 0.140625
Let procTime = Timer
For i = LBound(testNums) To UBound(testNums)
Let dummyStr = Chr(34623 + testNums(i))
Next i
Debug.Print "Test2: " & Timer - procTime 'Test2: 0.171875
End Sub
Private Function RandomLong(ByRef minVal As Long, ByRef maxVal As Long, Optional ByRef doRandomize As Boolean = True) As Long
If doRandomize Then
Randomize
End If
Let RandomLong = Int(Rnd * (maxVal - minVal + 1)) + minVal
End Function
⓪～㊿を全部並べてMid関数で取得した方が分かりやすいしできるならそうしたいんだけど、VBAは内部的にUnicode文字を使用しているものの、VBEはUnicode文字をサポートしていない。
ChrW関数などを使用してUnicode文字をサポートしている出力先（例えばWord文書など）に出力すること自体は可能なので、こういった書き方になった。もっとスマートな方法はないだろうか。