VBA 全角转半角

Option Explicit

Sub BatchReplace()
    Dim oDict, strKey
   
    Set oDict = CreateObject("Scripting.Dictionary")
   
    '全角数字转换为半角
    oDict.Add "１", "1"
    oDict.Add "２", "2"
    oDict.Add "３", "3"
    oDict.Add "４", "4"
    oDict.Add "５", "5"
    oDict.Add "６", "6"
    oDict.Add "７", "7"
    oDict.Add "８", "8"
    oDict.Add "９", "9"
    oDict.Add "０", "0"
    '小写全角转换
    oDict.Add "ａ", "a"
    oDict.Add "ｂ", "b"
    oDict.Add "ｃ", "c"
    oDict.Add "ｄ", "d"
    oDict.Add "ｅ", "e"
    oDict.Add "ｆ", "f"
    oDict.Add "ｇ", "g"
    oDict.Add "ｈ", "h"
    oDict.Add "ｉ", "i"
    oDict.Add "ｊ", "j"
    oDict.Add "ｋ", "k"
    oDict.Add "ｌ", "l"
    oDict.Add "ｍ", "m"
    oDict.Add "ｎ", "n"
    oDict.Add "ｏ", "o"
    oDict.Add "ｐ", "p"
    oDict.Add "ｑ", "q"
    oDict.Add "ｒ", "r"
    oDict.Add "ｓ", "s"
    oDict.Add "ｔ", "t"
    oDict.Add "ｕ", "u"
    oDict.Add "ｖ", "v"
    oDict.Add "ｗ", "w"
    oDict.Add "ｘ", "x"
    oDict.Add "ｙ", "y"
    oDict.Add "ｚ", "z"
　　'大写全角转换
    oDict.Add "Ａ", "A"
    oDict.Add "Ｂ", "B"
    oDict.Add "Ｃ", "C"
    oDict.Add "Ｄ", "D"
    oDict.Add "Ｅ", "E"
    oDict.Add "Ｆ", "F"
    oDict.Add "Ｇ", "G"
    oDict.Add "Ｈ", "H"
    oDict.Add "Ｉ", "I"
    oDict.Add "Ｊ", "J"
    oDict.Add "Ｋ", "K"
    oDict.Add "Ｌ", "L"
    oDict.Add "Ｍ", "M"
    oDict.Add "Ｎ", "N"
    oDict.Add "Ｏ", "O"
    oDict.Add "Ｐ", "P"
    oDict.Add "Ｑ", "Q"
    oDict.Add "Ｒ", "R"
    oDict.Add "Ｓ", "S"
    oDict.Add "Ｔ", "T"
    oDict.Add "Ｕ", "U"
    oDict.Add "Ｖ", "V"
    oDict.Add "Ｗ", "W"
    oDict.Add "Ｘ", "X"
    oDict.Add "Ｙ", "Y"
    oDict.Add "Ｚ", "Z"
    '标点符号
    oDict.Add "，", ","
    oDict.Add "：", ":"
    oDict.Add "；", ";"
    oDict.Add "（", "("
    oDict.Add "）", ")"
    oDict.Add "［", "["
    oDict.Add "］", "]"
    oDict.Add "．", "."
    oDict.Add "＋", "+"
    oDict.Add "％", "%"
    oDict.Add "／", "/"

   
    ' ......
    ' 在这里可以根据需要增加更多的替换规则
    ' ......
   
    For Each strKey In oDict.Keys
        Selection.Find.Execute FindText:=strKey, ReplaceWith:=oDict(strKey), Replace:=wdReplaceAll
        Selection.StartOf wdStory
    Next
   
    MsgBox "完成！"
End Sub