EXCEL VBA 文字コード表作成

文字コード一覧表を作成するマクロを作成してみました。

次、入れるかも知れないお仕事で、
UTF-16を使うとのことなので・・・

**************************************************
Option Explicit

Sub MojiCodeTbl()
　Dim i　　　As Long　 ' 行
　Dim k　　　As Long　 ' 区
　Dim t　　　As Long　 ' 点
　Dim jisCd　As String ' JISコード
　Dim SjisCd As String ' Shift-JISコード
　Dim uniCd　As String ' Unicode
　Dim Moji　 As String ' 文字
　
　On Error Resume Next
　i = 1
　For k = 1 To 94
　　For t = 1 To 94
　　' 区点 ==> JIS(16進数)
　　　jisCd = CStr(Hex(k + 32)) & CStr(Hex(t + 32))
　　' JIS(16進数) ==> S-JIS(16進数)
　　　SjisCd = Jis2SJis(jisCd)
　　' S-JIS(16進数) ==> 文字
　　　Moji = Chr(Int("&H" & SjisCd))
　　' 文字 ==> UTF16(16進数)
　　　uniCd = Right("00" & Hex(AscW(Moji)), 4)
　　　If uniCd = "30FB" And jisCd > "2126" Then
　　'　 Cells(i, 5).Value = "----"
　　　Else
　　　　i = i + 1
　　　　Cells(i, 1).Value = k　　　'区
　　　　Cells(i, 2).Value = t　　　'点
　　　　Cells(i, 3).Value = jisCd　'JIS
　　　　Cells(i, 4).Value = SjisCd 'S-JIS
　　　　Cells(i, 5).Value = uniCd　'UTF16
　　　　Cells(i, 6).Value = Moji　 '文字
　　　　Cells(i, 6).Select
　　　　If i = Int(i / 25) * 25 Then
　　　　　Application.ScreenUpdating = True
　　　　　Cells(i, 6).Select
　　　　　Application.ScreenUpdating = False
　　　　End If
　　　End If
　　Next t
　Next k
　Range(Cells(1, 1), Cells(i, 6)).Select
　Selection.Borders.LineStyle = xlContinuous
　Cells(1, 1).Select
　Application.ScreenUpdating = True
　Cells(2, 1).Select
End Sub

Function Jis2SJis(jis As String) As String
　Dim hi As Long
　Dim lo As Long
　hi = "&H" & Left(jis, 2)
　lo = "&H" & Right(jis, 2)
　If hi And 1 Then
　　If lo < &H60 Then
　　　lo = lo + &H1F
　　Else
　　　lo = lo + &H20
　　End If
　Else
　　lo = lo + &H7E
　End If
　If hi < &H5F Then
　　hi = (hi + &HE1) \ 2
　Else
　　hi = (hi + &H161) \ 2
　End If
　Jis2SJis = CStr(Hex(hi * &H100 + lo))
End Function