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 EachstrKey InDic.Keys   
       Selection.Find.Execute FindText:=strKey, ReplaceWith:=Dic(strKey),Replace:=wdReplaceAll   
       Selection.StartOfwdStory   
   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