AAA
' VeriationSelectorを除去する
Dim variationSelectorRemover As variationSelectorRemover
Set variationSelectorRemover = New variationSelectorRemover
name = variationSelectorRemover.Remove(name, resultMap)
For Each key In resultMap
message = message & "「" & key & "」を「" & resultMap.Item(key) & "」に変換しました【VS】" & vbCrLf
Next
' 異体字→常用漢字に変換する
Dim joyoKanjiNormalizer As joyoKanjiNormalizer
Set joyoKanjiNormalizer = New joyoKanjiNormalizer
name = joyoKanjiNormalizer.Normalize(name, resultMap)
For Each key In resultMap
message = message & "「" & key & "」を「" & resultMap.Item(key) & "」に変換しました【異体字】" & vbCrLf
Next
' 変換不可の外字を取得する
Dim gaijiChecker As gaijiChecker
Set gaijiChecker = New gaijiChecker
Call gaijiChecker.HasGaiji(name, resultMap)
For Each key In resultMap
Dim code As Long
code = WorksheetFunction.Unicode(resultMap.Item(key))
message = message & key & "文字目に外字「" & resultMap.Item(key) & "/" & Hex(code) & "」がありました" & vbCrLf
Next
'GaijiChecker
Option Explicit
' マスタのシート名および開始行
Private Const SHEET_NAME = "M_使用可能文字"
Private Const MASTER_DATA_BEGIN_ROW As Long = 2
' 利用可能文字のリスト
Private usableCharacters As Dictionary
'
' [処理] 外字を含むかどうか
' [引数] str: 入力文字列
' gaijiMap: 外字の連想配列(文字位置, 文字)
' [戻り値] True: 外字を含む
'
Public Function HasGaiji(str As String, ByRef gaijiMap As Dictionary) As Boolean
Dim gaiji_flag As Boolean
gaiji_flag = False
Call gaijiMap.RemoveAll
' 初めて関数が呼ばれた場合、マスタデータを取得する
If (usableCharacters Is Nothing) Then
Set usableCharacters = GetMasterData()
End If
Dim i As Long
For i = 1 To Len(str)
Dim c As String
c = Mid(str, i, 1)
' 4バイト文字である場合、2文字分を取得する
Dim is4Byte As Boolean
is4Byte = Is4ByteCharacter(c)
If (is4Byte) Then
c = Mid(str, i, 2)
End If
' 利用可能文字でない場合
If Not (usableCharacters.Exists(c)) Then
Call gaijiMap.Add(i, c)
gaiji_flag = True
End If
If (is4Byte) Then
i = i + 1
End If
Next
HasGaiji = gaiji_flag
End Function
'
' マスタデータを取得する
'
Private Function GetMasterData() As Dictionary
With ThisWorkbook.Worksheets(SHEET_NAME)
Dim last_row As Long
last_row = .Range("A1").End(xlDown).Row
Dim dic As Dictionary
Set dic = New Dictionary
Dim i As Long
For i = MASTER_DATA_BEGIN_ROW To last_row
Dim c As String
c = .Cells(i, 2)
' MapではなくSetとして利用するため、Valueには適当な値を設定する
Call dic.Add(c, "")
Next
End With
Set GetMasterData = dic
End Function
CCC
'JoyoKanjiNormalizer
Option Explicit
' マスタのシート名および開始行
Private Const SHEET_NAME = "M_新旧字体対応"
Private Const MASTER_DATA_BEGIN_ROW As Long = 3
' 新旧字体の文字を保持する連想配列
Private gaijiToJoyoMap As Dictionary
'
' [処理] 異体字を対応する常用漢字へ変換する
' [引数] str: 異体字を含む文字列
' replacedMap:変換した文字の連想配列(変換前 -> 後)
' [戻り値] 常用漢字へ変換後の文字列
'
Public Function Normalize(str As String, ByRef replacedMap As Dictionary) As String
Const CONVERTED_MARK = &H0
Call replacedMap.RemoveAll
' 初めて関数が呼ばれた場合、マスタデータを取得する
If (gaijiToJoyoMap Is Nothing) Then
Set gaijiToJoyoMap = GetMasterData()
End If
Dim i As Long
For i = 1 To Len(str)
Dim c As String
c = Mid(str, i, 1)
' 4バイト文字である場合、2文字分を取得する
Dim is4Byte As Boolean
is4Byte = Is4ByteCharacter(c)
If (is4Byte) Then
c = Mid(str, i, 2)
End If
' 常用漢字に変換可能な場合
If (gaijiToJoyoMap.Exists(c)) Then
If Not replacedMap.Exists(c) Then
Call replacedMap.Add(c, gaijiToJoyoMap.Item(c))
End If
Mid(str, i, 1) = gaijiToJoyoMap.Item(c)
' 4バイト文字の2文字目は削除対象にする
If (is4Byte) Then
Mid(str, i + 1) = Chr(CONVERTED_MARK)
i = i + 1
End If
End If
Next
str = Replace(str, Chr(CONVERTED_MARK), "")
Normalize = str
End Function
'
' マスタデータを取得する
'
Private Function GetMasterData() As Dictionary
With ThisWorkbook.Worksheets(SHEET_NAME)
Dim last_row As Long
last_row = .Range("A1").End(xlDown).Row
Dim dic As Dictionary
Set dic = New Dictionary
Dim i As Long
For i = MASTER_DATA_BEGIN_ROW To last_row
Dim before As String
Dim after As String
before = .Cells(i, 1)
after = .Cells(i, 2)
Call dic.Add(before, after)
Next
End With
Set GetMasterData = dic
End Function
DDD
'ValidationSelectorRemover
Option Explicit
'
' [処理] IVS登録文字のVariation Selectorを取り除く
' [引数] str: 対象文字列
' replacedMap: 除去前後の文字の連想配列(除去前, 除去後)
' [戻り値] Variation Selectorを除去した文字列
' [補足]
' IVS : Ideographic Variation Sequence
' 例．にしんにょうの辻 ：8FBB
' いっしんにょうの辻 ：8FBB + E0100(VS)
' 「+E01XX」の2文字を取り除く
Public Function Remove(str As String, ByRef replacedMap As Dictionary) As String
Const REPLACED_MARK As String = &H0
Call replacedMap.RemoveAll
Dim i As Long
For i = 1 To Len(str) - 2
Dim c As String
' 文字に対するVariation Selectorの相対位置
Dim vs_offset_pos As Long
If (StringUtil.Is4ByteCharacter(Mid(str, i, 1))) Then
c = Mid(str, i, 2)
vs_offset_pos = 2
Else
c = Mid(str, i, 1)
vs_offset_pos = 1
End If
' 末端文字がVariation Selectorを持たず、文字長を超過する場合は処理を打ち切る
If (i + vs_offset_pos + 1 > Len(str)) Then
Exit For
End If
' 2バイト文字の場合、Variation Selector含め3文字であるため,2,3文字目を取得する
' 4バイト文字の場合、Variation Selector含め4文字であるため,3,4文字目を取得する
Dim n1 As String
Dim n2 As String
n1 = Mid(str, i + vs_offset_pos, 1)
n2 = Mid(str, i + vs_offset_pos + 1, 1)
' Variation Selectorを持つ場合
If (IsVariationSelector(n1, n2)) Then
If Not replacedMap.Exists(c & n1 & n2) Then
Call replacedMap.Add(c & n1 & n2, c)
End If
Mid(str, i + vs_offset_pos, 1) = Chr(REPLACED_MARK)
Mid(str, i + vs_offset_pos + 1, 1) = Chr(REPLACED_MARK)
i = i + 2
End If
Next
' Variation Selectorを全て取り除く
str = Replace(str, Chr(REPLACED_MARK), "")
Remove = str
End Function
' 指定文字がVariation Selectorであるか
Private Function IsVariationSelector(n1 As String, n2 As String) As Boolean
Dim code1 As Long
Dim code2 As Long
code1 = AscW(n1)
code2 = AscW(n2)
' Variation Selectorの取りうるコードポイント(U+E0100 - U+E01EF)
IsVariationSelector = (code1 = &HDB40 And (&HDD00 <= code2 And code2 <= &HDDEF))
End Function
'
' [処理] サロゲートペア(4バイト)の文字であるか
' [引数] c : サロゲートペアの上位2バイト(1文字)
' [戻り値] True：サロゲートペアである
'
Public Function Is4ByteCharacter(c As String) As Boolean
Dim code As Long
code = AscW(c)
Is4ByteCharacter = (&HD800 <= code And code <= &HDBFF)
End Function