将十六进制值转为Unicode （GB2312）字符的编程问题

aihuang · 发表于 2008-3-7 19:38

gb2312与UTF8之间的转换下面是从网上搜集的,gb2312与UTF8之间的转换
如何改成VBA命令:
求:将word文件中的所有乱码转成汉字
例: 啊 转成啊
阿 转成阿

'UTF转gb2312---将UTF8编码文字转换为gb2312编码文字
function UTF2GB(UTFStr)
for Dig=1 to len(UTFStr)
'如果UTF8编码文字以%开头则进行转换
if mid(UTFStr,Dig,1)="%" then
'UTF8编码文字大于8则转换为汉字
if len(UTFStr) >= Dig+8 then
GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9))
Dig=Dig+8
else
GBStr=GBStr & mid(UTFStr,Dig,1)
end if
else
GBStr=GBStr & mid(UTFStr,Dig,1)
end if
next
UTF2GB=GBStr
end function
'UTF8编码文字将转换为汉字
function ConvChinese(x)
A=split(mid(x,2),"%")
i=0
j=0
for i=0 to ubound(A)
A(i)=c16to2(A(i))
next
for i=0 to ubound(A)-1
DigS=instr(A(i),"0")
Unicode=""
for j=1 to DigS-1
if j=1 then
A(i)=right(A(i),len(A(i))-DigS)
Unicode=Unicode & A(i)
else
i=i+1
A(i)=right(A(i),len(A(i))-2)
Unicode=Unicode & A(i)
end if
next
if len(c2to16(Unicode))=4 then
ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode)))
else
ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode)))
end if
next
end function

[此贴子已经被守柔于2008-3-8 6:58:45编辑过]

chylhr · 发表于 2008-3-8 00:08

'时间关系,简单写了一个先给楼主应急。等守柔版主来了再给你个更好的。

Sub Test()

Dim myRange As Range

Set myRange = ActiveDocument.Content

With myRange.Find

.ClearFormatting

Do While .Execute(findtext:="&#x????", MatchWildcards:=True, Wrap:=wdFindStop)

myRange = ChrW("&H" & Right(myRange, 4))

myRange.SetRange myRange.End, ActiveDocument.Content.End

Loop

End With

End Sub

守柔 · 发表于 2008-3-8 07:04

QUOTE:

以下是引用chylhr在2008-3-8 0:08:41的发言：

'时间关系,简单写了一个先给楼主应急。等守柔版主来了再给你个更好的。

Sub Test()

Dim myRange As Range

Set myRange = ActiveDocument.Content

With myRange.Find

.ClearFormatting

Do While .Execute(findtext:="&#x????", MatchWildcards:=True, Wrap:=wdFindStop)

myRange = ChrW("&H" & Right(myRange, 4))

myRange.SetRange myRange.End, ActiveDocument.Content.End

Loop

End With

End Sub

谢谢chylhr兄！有一阵子没有见到你了。

代码很好。

我也写了一下（实际上大同小异），顺便验证了一下效率（RANGE对象与SELECTION对象的查找效率，参http://club.excelhome.net/viewthread.php?tid=296524&replyID=&skin=0）

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-3-8 7:00:17
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0353^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub Example()
    Dim sngStart As Single, sngEnd As Single
    sngStart = Timer
    Application.ScreenUpdating = False
    With Selection
        .HomeKey wdStory
        Do While .Find.Execute(findtext:="&#x^?^?^?^?", Forward:=True, Wrap:=wdFindStop, MatchWildcards:=False)
            .Text = Replace(Selection.Text, "&#x", "")
            .ToggleCharacterCode
            .MoveRight wdCharacter
        Loop
    End With
    Application.ScreenUpdating = True
    sngEnd = Timer
    MsgBox "用时" & sngEnd - sngStart & "秒!"
End Sub
'----------------------
对于一个177页的模拟文档，RANGE对象使用FIND时，139.2012S;SELECTION对象使用FIND用时102.377S,加上Application.Screenupdating=False时的用时为73.02539S.

aihuang · 发表于 2008-3-8 21:55

谢谢chylhr ,和守柔大哥的帮忙

还有一点,如果带上分号呢 啊

守柔 · 发表于 2008-3-9 06:36

QUOTE:

以下是引用aihuang在2008-3-8 21:55:38的发言：

谢谢chylhr ,和守柔大哥的帮忙

还有一点,如果带上分号呢 啊

请参考：

Sub Example()
    Dim strFind As String
    Application.ScreenUpdating = False
    With Selection
        .HomeKey wdStory
        Do While .Find.Execute(findtext:="&#x^?^?^?^?;", Forward:=True, Wrap:=wdFindStop, MatchWildcards:=False)
            strFind = .Text
            strFind = Replace(strFind, "&#x", "")
            strFind = Replace(strFind, ";", "")
            .Text = strFind
            .ToggleCharacterCode
            .MoveRight wdCharacter
        Loop
    End With
    Application.ScreenUpdating = True
End Sub
Sub Test()
   Dim myRange As Range
   Set myRange = ActiveDocument.Content
   With myRange.Find
       .ClearFormatting
       Do While .Execute(findtext:="&#x????;", MatchWildcards:=True, Wrap:=wdFindStop)
          myRange = ChrW("&H" & Mid(myRange.Text, 4, Len(myRange.Text) - 4))
          myRange.SetRange myRange.End, ActiveDocument.Content.End
       Loop
   End With
End Sub

aihuang · 发表于 2008-3-9 22:00

不愧是老大,真的配服

有些懂得Replace()的用法了

谢谢

chylhr · 发表于 2008-3-15 23:49

QUOTE:

以下是引用守柔在2008-3-8 7:04:42的发言：

谢谢chylhr兄！有一阵子没有见到你了。

代码很好。

我也写了一下（实际上大同小异），顺便验证了一下效率（RANGE对象与SELECTION对象的查找效率，参http://club.excelhome.net/viewthread.php?tid=296524&replyID=&skin=0）

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-3-8 7:00:17
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0353^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub Example()
    Dim sngStart As Single, sngEnd As Single
    sngStart = Timer
    Application.ScreenUpdating = False
    With Selection
        .HomeKey wdStory
        Do While .Find.Execute(findtext:="&#x^?^?^?^?", Forward:=True, Wrap:=wdFindStop, MatchWildcards:=False)
            .Text = Replace(Selection.Text, "&#x", "")
            .ToggleCharacterCode
            .MoveRight wdCharacter
        Loop
    End With
    Application.ScreenUpdating = True
    sngEnd = Timer
    MsgBox "用时" & sngEnd - sngStart & "秒!"
End Sub
'----------------------
对于一个177页的模拟文档，RANGE对象使用FIND时，139.2012S;SELECTION对象使用FIND用时102.377S,加上Application.Screenupdating=False时的用时为73.02539S.

谢谢守兄。我原以为在任何情况下Range都比Selection快，应该改为在多数情况下Range比Selection快了。

很想常回家看看,但最近很少有时间和精力来论坛了，只有借着晚上值班的机会上来看看了。

		自动登录	找回密码
密码			免费注册