社区 › VBA/VB/ActiveX/API 编程技术 › 准备写个图形简繁转换的程序，大家说说怎样提高运行速度

mccad 发表于 2005-9-11 21:27:00

准备写个图形简繁转换的程序，大家说说怎样提高运行速度

最基本的方法就是一个字符一个字符的替换。而且需要在对照表顺查找字符。而做了统计，需要对照的汉字大约有2.2万个。如果说每个汉字都要在对照表中一个一个字的查找，速度显然是慢了。就着“齄”字，它是对照表中的最后一个字，如果需要替换字符串都是这个字，则每次都需要查2.2万次才能找到这个字。如果有100个这样的字，呵呵，那真的有些慢，虽然我没有试运行过。程序如下：
[注意其中ChsStr为整个简体对照表，ChtStr为繁体对照表，简体和繁体的位置是一一对应的。]Function Cht2Chs(Str As String) As String
    Dim i As Long
    Dim jAs Long
    Dim tmpStr As String
    Dim sAs String
    For i = 1 To Len(Str)
      s = Mid(Str, i, 1)
      For j = 1 To Len(ChsStr)
            If s = Mid(ChsStr, j, 1) Then
                s = Mid(ChtStr, j, 1)
                Exit For
            End If
      Next
      tmpStr = tmpStr & s
    Next
    Cht2Chs = tmpStr
End Function

我已经找到一个比较快的方法，而且也写出来了。但希望大家一起来想，所以这种方法暂时不公布。
这个程序完成后，我会把主要代码公布出来。

雪山飞狐_lzh 发表于 2005-9-12 11:33:00

<P>用数据库试试：）</P>

MJTD_7777 发表于 2005-9-12 12:54:00

<P>直接换字库文件行吗？</P>
<P>你不是说：“注意其中ChsStr为整个简体对照表，ChtStr为繁体对照表，简体和繁体的位置是一一对应的。”</P>
<P>&nbsp;</P>
<P>&nbsp;</P>

mikewolf2k 发表于 2005-9-12 18:34:00

<P>想不到不一个个去找还有什么简便方法，看看老大的方法。</P>
<P>简繁字转换我用不着，不过想做一个选择所有文件完成这些文件内文字替换的程序，看看有什么可以参考的。</P>

mccad 发表于 2005-9-12 19:33:00

<P>我还是不卖关子了。<BR>我的方法非常简单，不需要在对照表中一个字一个字的查找对应的字。速度可提高上万倍。也不用数据库。<BR>我是通过数组来解决。把简体字的ASCII码做为数组的下标，繁体字的ASCII码做为数组指定下标的值。<BR>首先在程序运行时做一些填充数组的工作，然后就直接在程序中使用。<BR>在替换字时直接取得字的ASCII码，通过该下标就可以直接读到对应的数组值。一转换出来就是繁体字了。</P>
<P>是不是非常简单和快。</P>
<P>还有没有更快的方法。</P>

mccad 发表于 2005-9-12 21:40:00

主要代码：Function ChtToChs(Str As String) As String
    Dim i As Long
    Dim tmpStr As String
    Dim sAs String
    Dim StrList As Variant
    StrList = GetStrList
    For i = 1 To Len(Str)
      s = Mid(Str, i, 1)
      If Asc(s) <= -2050 Then
            s = Chr(StrList(Asc(s) + 24159))
      End If
      tmpStr = tmpStr & s
    Next
    ChtToChs = tmpStr
End Function
Function GetStrList() As Variant
    Dim StrList(22109) As Long
    Dim i As Long
    Dim ChsStr As String
    Dim ChtStr As String
    ChsStr = GetChsStr
    ChtStr = GetChtStr
    For i = 1 To Len(ChsStr)
      StrList(Asc(Mid(ChsStr, i, 1)) + 24159) = Asc(Mid(ChtStr, i, 1))
    Next
    GetStrList = StrList
End Function

mccad 发表于 2005-9-13 21:17:00

应该还有一种方法，也是很快的。

mccad 发表于 2005-9-16 06:48:00

Sub Main()
    Dim Str As String
    Dim tmpStr As String
    Dim tt As Single
   
    Str = GetStr(True)
    tt = Timer()
    tmpStr = ChsToCht0(Str)
    Debug.Print "使用逐个查找法的时间：" & Format(Timer() - tt, "0.00000") & "秒"
    tt = Timer()
    tmpStr = ChsToCht1(Str)
    Debug.Print "使用列表法的时间：" & Format(Timer() - tt, "0.00000") & "秒"
   
    tt = Timer()
    tmpStr = ChsToCht2(Str)
    Debug.Print "使用位置法的时间：" & Format(Timer() - tt, "0.00000") & "秒"
   
End SubFunction ChsToCht1(Str As String) As String
    Dim i As Long
    Dim tmpStr As String
    Dim sAs String
    Dim StrList As Variant
    StrList = GetStrList
    For i = 1 To Len(Str)
      s = Mid(Str, i, 1)
      If Asc(s) <= -2050 Then
            s = Chr(StrList(Asc(s) + 24159))
      End If
      tmpStr = tmpStr & s
    Next
    ChsToCht1 = tmpStr
End Function
Function ChsToCht2(Str As String) As String
    Dim ChsStr As String
    Dim ChtStr As String
    ChsStr = GetStr(True)
    ChtStr = GetStr(False)
    Dim i As Long
    Dim tmpStr As String
    Dim sAs String
    Dim leftStr As String
    For i = 1 To Len(Str)
      s = Mid(Str, i, 1)
      If Asc(s) <= -2050 Then
      s = Mid(ChtStr, InStrRev(ChsStr, s), 1)
      End If
      tmpStr = tmpStr & s
    Next
    ChsToCht2 = tmpStr
End Function
Function ChsToCht0(Str As String) As String
    Dim ChsStr As String
    Dim ChtStr As String
    ChsStr = GetStr(True)
    ChtStr = GetStr(False)
    Dim i As Long
    Dim jAs Long
    Dim tmpStr As String
    Dim sAs String
    For i = 1 To Len(Str)
      s = Mid(Str, i, 1)
      For j = 1 To Len(ChsStr)
            If s = Mid(ChsStr, j, 1) Then
                s = Mid(ChtStr, j, 1)
                Exit For
            End If
      Next
      tmpStr = tmpStr & s
    Next
    ChsToCht0 = tmpStr
End Function
Function GetStrList() As Variant
    Dim StrList(22109) As Long
    Dim i As Long
    Dim ChsStr As String
    Dim ChtStr As String
    ChsStr = GetStr(True)
    ChtStr = GetStr(False)
    For i = 1 To Len(ChsStr)
      StrList(Asc(Mid(ChsStr, i, 1)) + 24159) = Asc(Mid(ChtStr, i, 1))
    Next
    GetStrList = StrList
End Function
Function GetStr(isChs As Boolean) As String
    Dim strFile As String
    Dim strPath As String
    Dim strText As String
    strFile = VBE.ActiveVBProject.FileName
    strPath = Left(strFile, InStrRev(strFile, "\"))
    If isChs Then
      strFile = "chsstr.dat"
    Else
      strFile = "chtstr.dat"
    End If
      Open strPath & strFile For Input As #1
    Do Until EOF(1)
      Line Input #1, strText
      GetStr = GetStr & strText
    Loop
    Close #1
End Function运行后的速度比较：使用逐个查找法的时间：12.89063秒
使用列表法的时间：0.02930秒
使用位置法的时间：0.97070秒可以看到，我把整个简体表做为需要转换的字符串，整个运行速度中，列表法是最快的，而位置法则还不错。但查找法则不可行。

另外，查找法还可以进行优化，优化的条件是对照表中原始表(即简体表)字符按ASCII码排序，这样则可以通过筛选来一半一半筛选。如20个字，取第10个字，看ASC码与要比较字符的大小而决定是取前面一半的字符还是后面一半的字符继续进行比较。

MJTD_7777 发表于 2005-9-16 09:31:00

<P>能看看你的文件吗？</P>
<P>chsstr.dat<BR>chtstr.dat<BR></P>

my_computer 发表于 2005-9-19 09:24:00

<P>其实能不能体速关键看你程序的核心。</P>
<P>s = Chr(StrList(Asc(s) + 24159))</P>
<P><BR>已经使速度发挥到极限了。</P>
<P>除非取数组中数值的速度影响程序的运行。</P>

查看完整版本: 准备写个图形简繁转换的程序，大家说说怎样提高运行速度