VBA 全角转半角

'使用前需先选中要替换的区域

 

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

 

 

Sub 代码全角转半角B方法()
Dim qjsz$, bjsz$, i%
qjsz = "０１２３４５６７８９ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ＜＞｛｝（）；，：．／＼！＃＆％＝"
bjsz = "0123456789abcdefghijklmnopqrstuvwxyz<>{}();,:./\!#&%="
For i = 1 To 60
With Selection.Find
.Text = Mid(qjsz, i, 1)
.Replacement.Text = Mid(bjsz, i, 1)
.Format = False
.Execute Replace:=wdReplaceAll
End With
Next i
End Sub