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

mccad

最基本的方法就是一个字符一个字符的替换。而且需要在对照表顺查找字符。而做了统计，需要对照的汉字大约有2.2万个。如果说每个汉字都要在对照表中一个一个字的查找，速度显然是慢了。就着“齄”字，它是对照表中的最后一个字，如果需要替换字符串都是这个字，则每次都需要查2.2万次才能找到这个字。如果有100个这样的字，呵呵，那真的有些慢，虽然我没有试运行过。程序如下：
[注意其中ChsStr为整个简体对照表，ChtStr为繁体对照表，简体和繁体的位置是一一对应的。]

2. Function Cht2Chs(Str As String) As String
3.     Dim i As Long
4.     Dim j  As Long
5.     Dim tmpStr As String
6.     Dim s  As String
7.     For i = 1 To Len(Str)
8.         s = Mid(Str, i, 1)
9.         For j = 1 To Len(ChsStr)
10.             If s = Mid(ChsStr, j, 1) Then
11.                 s = Mid(ChtStr, j, 1)
12.                 Exit For
13.             End If
14.         Next
15.         tmpStr = tmpStr & s
16.     Next
17.     Cht2Chs = tmpStr
18. End Function

Function Cht2Chs(Str As String) As String     Dim i As Long     Dim j  As Long     Dim tmpStr As String     Dim s  As 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

用数据库试试：）

MJTD_7777

直接换字库文件行吗？

你不是说：“注意其中ChsStr为整个简体对照表，ChtStr为繁体对照表，简体和繁体的位置是一一对应的。”

 

 

mikewolf2k

想不到不一个个去找还有什么简便方法，看看老大的方法。

简繁字转换我用不着，不过想做一个选择所有文件完成这些文件内文字替换的程序，看看有什么可以参考的。

mccad

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

是不是非常简单和快。

还有没有更快的方法。

mccad

主要代码：

2. Function ChtToChs(Str As String) As String
3.     Dim i As Long
4.     Dim tmpStr As String
5.     Dim s  As String
6.     Dim StrList As Variant
7.     StrList = GetStrList
8.     For i = 1 To Len(Str)
9.         s = Mid(Str, i, 1)
10.         If Asc(s) <= -2050 Then
11.             s = Chr(StrList(Asc(s) + 24159))
12.         End If
13.         tmpStr = tmpStr & s
14.     Next
15.     ChtToChs = tmpStr
16. End Function
17. Function GetStrList() As Variant
18.     Dim StrList(22109) As Long
19.     Dim i As Long
20.     Dim ChsStr As String
21.     Dim ChtStr As String
22.     ChsStr = GetChsStr
23.     ChtStr = GetChtStr
24.     For i = 1 To Len(ChsStr)
25.         StrList(Asc(Mid(ChsStr, i, 1)) + 24159) = Asc(Mid(ChtStr, i, 1))
26.     Next
27.     GetStrList = StrList
28. End Function

Function ChtToChs(Str As String) As String     Dim i As Long     Dim tmpStr As String     Dim s  As 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

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

mccad

2. Sub Main()
3.     Dim Str As String
4.     Dim tmpStr As String
5.     Dim tt As Single
6.    
7.     Str = GetStr(True)
8.     tt = Timer()
9.     tmpStr = ChsToCht0(Str)
10.     Debug.Print "使用逐个查找法的时间：" & Format(Timer() - tt, "0.00000") & "秒"
11.     tt = Timer()
12.     tmpStr = ChsToCht1(Str)
13.     Debug.Print "使用列表法的时间：" & Format(Timer() - tt, "0.00000") & "秒"
14.    
15.     tt = Timer()
16.     tmpStr = ChsToCht2(Str)
17.     Debug.Print "使用位置法的时间：" & Format(Timer() - tt, "0.00000") & "秒"
18.    
19. End Sub

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 Sub

2. Function ChsToCht1(Str As String) As String
3.     Dim i As Long
4.     Dim tmpStr As String
5.     Dim s  As String
6.     Dim StrList As Variant
7.     StrList = GetStrList
8.     For i = 1 To Len(Str)
9.         s = Mid(Str, i, 1)
10.         If Asc(s) <= -2050 Then
11.             s = Chr(StrList(Asc(s) + 24159))
12.         End If
13.         tmpStr = tmpStr & s
14.     Next
15.     ChsToCht1 = tmpStr
16. End Function
17. Function ChsToCht2(Str As String) As String
18.     Dim ChsStr As String
19.     Dim ChtStr As String
20.     ChsStr = GetStr(True)
21.     ChtStr = GetStr(False)
22.     Dim i As Long
23.     Dim tmpStr As String
24.     Dim s  As String
25.     Dim leftStr As String
26.     For i = 1 To Len(Str)
27.         s = Mid(Str, i, 1)
28.         If Asc(s) <= -2050 Then
29.         s = Mid(ChtStr, InStrRev(ChsStr, s), 1)
30.         End If
31.         tmpStr = tmpStr & s
32.     Next
33.     ChsToCht2 = tmpStr
34. End Function
35. Function ChsToCht0(Str As String) As String
36.     Dim ChsStr As String
37.     Dim ChtStr As String
38.     ChsStr = GetStr(True)
39.     ChtStr = GetStr(False)
40.     Dim i As Long
41.     Dim j  As Long
42.     Dim tmpStr As String
43.     Dim s  As String
44.     For i = 1 To Len(Str)
45.         s = Mid(Str, i, 1)
46.         For j = 1 To Len(ChsStr)
47.             If s = Mid(ChsStr, j, 1) Then
48.                 s = Mid(ChtStr, j, 1)
49.                 Exit For
50.             End If
51.         Next
52.         tmpStr = tmpStr & s
53.     Next
54.     ChsToCht0 = tmpStr
55. End Function
56. Function GetStrList() As Variant
57.     Dim StrList(22109) As Long
58.     Dim i As Long
59.     Dim ChsStr As String
60.     Dim ChtStr As String
61.     ChsStr = GetStr(True)
62.     ChtStr = GetStr(False)
63.     For i = 1 To Len(ChsStr)
64.         StrList(Asc(Mid(ChsStr, i, 1)) + 24159) = Asc(Mid(ChtStr, i, 1))
65.     Next
66.     GetStrList = StrList
67. End Function
68. Function GetStr(isChs As Boolean) As String
69.     Dim strFile As String
70.     Dim strPath As String
71.     Dim strText As String
72.     strFile = VBE.ActiveVBProject.FileName
73.     strPath = Left(strFile, InStrRev(strFile, ""))
74.     If isChs Then
75.         strFile = "chsstr.dat"
76.     Else
77.         strFile = "chtstr.dat"
78.     End If
79.         Open strPath & strFile For Input As #1
80.     Do Until EOF(1)
81.         Line Input #1, strText
82.         GetStr = GetStr & strText
83.     Loop
84.     Close #1
85. End Function

Function ChsToCht1(Str As String) As String     Dim i As Long     Dim tmpStr As String     Dim s  As 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 s  As 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 j  As Long     Dim tmpStr As String     Dim s  As 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

运行后的速度比较：

1. 使用逐个查找法的时间：12.89063秒
2. 使用列表法的时间：0.02930秒
3. 使用位置法的时间：0.97070秒

复制代码

可以看到，我把整个简体表做为需要转换的字符串，整个运行速度中，列表法是最快的，而位置法则还不错。但查找法则不可行。

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

MJTD_7777

能看看你的文件吗？

chsstr.dat
chtstr.dat

my_computer

其实能不能体速关键看你程序的核心。

s = Chr(StrList(Asc(s) + 24159))

已经使速度发挥到极限了。

除非取数组中数值的速度影响程序的运行。