求最快的字符串查找算法，分只给算法效率最高的那位。

dim i as long
dim a() as string
a=split(str2,",")
for i=0 to ubound(a)
if str1=a(i) then ...
next

用instr函数嘛!!InStr 函数

返回 Variant (Long)，指定一字符串在另一字符串中最先出现的位置。语法 InStr([start, ]string1, string2[, compare])InStr 函数的语法具有下面的参数：部分说明
start 可选参数。为数值表达式，设置每次搜索的起点。如果省略，将从第一个字符的位置开始。如果 start 包含 Null，将发生错误。如果指定了 compare 参数，则一定要有 start 参数。
string1 必要参数。接受搜索的字符串表达式。
string2 必要参数。被搜索的字符串表达式。
Compare 可选参数。指定字符串比较。如果 compare 是 Null，将发生错误。如果省略 compare，Option Compare 的设置将决定比较的类型。设置 compare 参数设置为：常数值描述
vbUseCompareOption -1 使用Option Compare 语句设置执行一个比较。
vbBinaryCompare 0 执行一个二进制比较。
vbTextCompare 1 执行一个按照原文的比较。
vbDatabaseCompare 2 仅适用于Microsoft Access，执行一个基于数据库中信息的比较。返回值如果 InStr返回
string1 为零长度 0
string1 为 Null Null
string2 为零长度 Start
string2 为 Null Null
string2 找不到 0
在 string1 中找到string2 找到的位置
start > string2 0 说明InStrB 函数作用于包含在字符串中的字节数据。所以 InStrB 返回的是字节位置，而不是字符位置。

“最快”??
要看你Str2有多长，有的方法不需要准备工作，Str2短这些方法就快
有的方法需要做准备工作，但运行速度快，Str2长时这些方法快就象短跑运动员跑长跑就不行。

Str1 = "Aaa"
Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
Str3 = "," & Str1 & ","
Str4 = "," & Str2 & ","
intLoc = Instr(Str3, Str4)

Str1 = "Aaa"
Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD...Aaa"你可能想到过,刚才我简单的想了一下就提出Instr有点冒失~不过这个实在是最快的方法!
你可以在函数返回时,向后面查询一下,是不是","是的话就找到啰,不是就再找!很简单吧..呵呵!
do
    变量1=instr(str2,str1)
    if 变量1 <> 0 then
       找到也
       变量2 = Len(str1)
       变量1 = 变量1 + 变量2
       变量3 = Left(str2,变量1)
       if right(len(变量3),1) = "," then
          找到了,exit do 退出循环!
       else
          没找到,可以省略掉else让他循环继续!
       end if
    else
       什么都没找到
    end if
loop

不过,Aaa有可能在最后面,这就要设置一下出错的问题了,简单~

if right(len(变量3),1) = "," then
找到了,exit do 退出循环!判断里的len(变量3)写错了,不需要len函数!呵呵~

VertyNew(华)的方法最简单，但还不知运行效率如何。请大家写出完整的程序，我会对大家的算法进行10万次的测试，然后将测试结果公布出来，供大家讨论和学习。

fa7274(聂风)的方法存在“字母大小写”的问题，例如，“Aaa"和"AAA"得到的结果应该是一样的.注意：不区分大小写

str1 = "Aaa"
str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD,Aaa"MsgBox InStr("," & str2 & ",", "," & str1 & ",")

例如查找"Aaa"在"DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."位置时，AaaF和AaaD都不是有效值
是什么意思啊???

给你一个对分法：
Dim j
Private Sub Command1_Click()
j = 0
MsgBox dd("Aaa", "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD")
End SubFunction dd(strS As String, strSS As String)
Dim temp As String
Dim i, n
If InStr(1, strSS, ",") = 0 Then
dd = j
Exit Function
End If
For i = Round(Len(strSS) / 2) - 1 To Len(strSS)
  If Mid(strSS, i, 1) = "," Then
    temp = Left(strSS, i - 1)
    n = Len(temp) - Len(Replace(temp, ",", "")) + 1
    Exit For
  End If
Next i
If InStr(1, "," & UCase(temp) & ",", "," & UCase(strS) & ",") > 0 Then
    If InStr(1, "," & UCase(temp) & ",", "," & UCase(strS) & ",") = 1 Then
      dd = j + 1
      Exit Function
    Else
      dd = dd(strS, temp)
    End If
Else
  temp = Right(strSS, Len(strSS) - i)
  If InStr(1, "," & UCase(temp) & ",", "," & UCase(strS) & ",") > 0 Then
    If InStr(1, "," & UCase(temp) & ",", "," & UCase(strS) & ",") = 1 Then
      dd = j + n + 1
      Exit Function
    Else
      j = j + n
      dd = dd(strS, temp)
    End If
  Else
  dd = 0
  End If
End If
End Function

To: helanshan()
例如查找"Aaa"在"DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."位置时，AaaF和AaaD都不是有效值
是什么意思啊???
=============================================================================="DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."是由逗号分隔的字符串，只有“AAA”与"Aaa"相匹配，
AaaF和AaaD都不“等于”"Aaa"

//只有“AAA”与"Aaa"相匹配哦，不分大小写的啊，那改成这样str1 = "Aaa"
str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD"'MsgBox InStr("," & UCase(str2) & ",", "," & UCase(str1) & ",")MsgBox Mid(str2, InStr("," & UCase(str2) & ",", "," & UCase(str1) & ","), Len(str1))

正则应该是最快地！！
引用 Microsoft VBScript Regular Expressions 1.0 library 对象
（本机是5.5）Private Sub Form_Load()
    Dim Str1 As String
    Dim Str2 As String
    Str1 = "Aaa"
    Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD,AaAa,aaa"
    MsgBox RegExpTest(Str1, Str2)
End Sub
Private Function RegExpTest(patrn As String, strng As String) As String

   Dim regEx As New RegExp   ' 建立正则表达式。
   Dim Matches As MatchCollection
   Dim mtch As Match
   Dim RetStr As String

   regEx.Pattern = patrn   ' 设置模式。
   regEx.IgnoreCase = True   ' 设置不区分大小写。
   regEx.Global = True   ' 设置全局查找。
   Set Matches = regEx.Execute(strng)   ' 执行搜索。

   For Each Match In Matches   ' 遍历 Matches 集合。
      RetStr = RetStr & Match.FirstIndex & Match.Value & vbCrLf
   Next

   RegExpTest = RetStr
End Function不信用timer做一个时间测试。
大家都写一个同名函数，用同一个测试函数调用。---------------------------
工程1
---------------------------
12AAA20Aaa25Aaa30AaA35aaa
---------------------------
确定
---------------------------

大家都没有注意InStr可以设置比较模式啊注意字符串连接操作需要重新分配内存，是很耗时间的！Dim Str1 as String,Str2 as String
Dim Pos as long,Pos2 as long
dim LenStr1 as long,LenStr2 as longStr1 = "Aaa"
Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
LenStr1=len(Str1)
LenStr2=len(str2)pos=1
Do
    pos=Instr(pos, Str2, Str1, vbTextCompare) '不区分大小写
    if pos=0 then exit do '查找失败

    '判断范围
    pos2=pos+lenstr1
    if pos2-1=lenstr2 then '查找成功
        exit do
    elseIf pos2-1>lenstr2 then '查找失败
        pos=0
        exit do
    End if

    '判断“,”，注意vbKeySnapshot与AscW(",")相等，AscW是最快的asc函数
    If AscW(Mid$(Str2, pos2, 1))=vbKeySnapshot then
        '查找成功
        exit do
    else
        '继续循环
    end if

loop'报告结果
msgbox pos-- zyl910公告（2004/8/28） ---------昨天突然打雷下雨
导致计算机突然断电
我那时正在上网今天雨才停
拨号一看
“没有拨号音”我在家里翻箱倒柜
总算找到一个Modem了
可惜是14.4kbps的
上网速度很不爽所以这几天可能不会上网了
（再过几天就开学了）

回复人： superdullwolf(超级大笨狼,每天要自强) ( ) 信誉：95  2004-08-28 04:50:00  得分: 0

   楼主的题目对正则来说大才小用了，应该出个更复杂点的。

=============================================你自己编一个解析正则表达式的类

dim i as long
dim a() as string
dim str1 as string, str2 as string
a=split(str2,",")
for i=0 to ubound(a)
  if len(str1)= len(a(i)) then     '如果长度不相等则不用比较
    if Ucase(str1)=Ucase(a(i)) then
       debug.print i
    end if
  end if
next

split、Ucase涉及到字符串的重分配
速度肯定很慢

发现一个小Bug：pos的循环问题
Dim Str1 as String,Str2 as String
Dim Pos as long,Pos2 as long
dim LenStr1 as long,LenStr2 as longStr1 = "Aaa"
Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
LenStr1=len(Str1)
LenStr2=len(str2)pos=0 '修改了这里
Do
    pos=Instr(pos+1, Str2, Str1, vbTextCompare) '不区分大小写
    if pos=0 then exit do '查找失败

    '判断范围
    pos2=pos+lenstr1
    if pos2-1=lenstr2 then '查找成功
        exit do
    elseIf pos2-1>lenstr2 then '查找失败
        pos=0
        exit do
    End if

    '判断“,”，注意vbKeySnapshot与AscW(",")相等，AscW是最快的asc函数
    If AscW(Mid$(Str2, pos2, 1))=vbKeySnapshot then
        '查找成功
        exit do
    else
        '继续循环
    end if

loop

测试程序如下：Private Function Test_FindString_01(ByVal Str1 As String, ByVal Str2 As String) As Boolean
    Dim i As Long
    Dim a() As String

    Str1 = UCase(Str1)
    a = Split(Str2, ",")

    For i = 0 To UBound(a)
        If Str1 = UCase(a(i)) Then
            Test_FindString_01 = True
            Exit For
        End If
    Next

    Erase a

    '=======测试结果(10万次循环）=========================================
    'Str1 = "Aaa"
    'Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
    '第1次 33秒  第2次 35秒  第3次 36秒

    '===================================================================

End FunctionPrivate Function Test_FindString_02(ByVal Str1 As String, ByVal Str2 As String) As Boolean
    Dim intLoc As Long

    Str1 = "," & Str1 & ","
    Str2 = "," & Str2 & ","

    intLoc = InStr(1, Str2, Str1, 1)

    If intLoc > 0 Then
        Test_FindString_02 = True
    End If

    '=======测试结果(10万次循环）=========================================
    'Str1 = "Aaa"
    'Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
    '第1次 5秒  第2次 5秒  第3次 5秒

    '===================================================================

End FunctionFunction Test_FindString_03(strS As String, strSS As String) As Long
    Dim temp As String
    Dim i As Long, n As Long

    If InStr(1, strSS, ",") = 0 Then
        Test_FindString_03 = i
        Exit Function
    End If

    For i = Round(Len(strSS) / 2) - 1 To Len(strSS)
        If Mid(strSS, i, 1) = "," Then
            temp = Left(strSS, i - 1)
            n = Len(temp) - Len(Replace(temp, ",", "")) + 1
            Exit For
        End If
    Next i

    If InStr(1, "," & UCase(temp) & ",", "," & UCase(strS) & ",") > 0 Then
        If InStr(1, "," & UCase(temp) & ",", "," & UCase(strS) & ",") = 1 Then
          Test_FindString_03 = i + 1
          Exit Function
        Else
          Test_FindString_03 = Test_FindString_03(strS, temp)
        End If
    Else
        temp = Right(strSS, Len(strSS) - i)
        If InStr(1, "," & UCase(temp) & ",", "," & UCase(strS) & ",") > 0 Then
            If InStr(1, "," & UCase(temp) & ",", "," & UCase(strS) & ",") = 1 Then
                Test_FindString_03 = i + n + 1
                Exit Function
            Else
                i = i + n
                Test_FindString_03 = Test_FindString_03(strS, temp)
            End If
        Else
            Test_FindString_03 = 0
        End If
    End If

    '=======测试结果(10万次循环）=========================================
    'Str1 = "Aaa"
    'Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
    '第1次 807秒

    '===================================================================End FunctionPrivate Function RegExpTest(patrn As String, strng As String) As String

   Dim regEx As New RegExp   ' 建立正则表达式。
   Dim Matches As MatchCollection
   Dim mtch As Match
   Dim RetStr As String

   regEx.Pattern = patrn   ' 设置模式。
   regEx.IgnoreCase = True   ' 设置不区分大小写。
   regEx.Global = True   ' 设置全局查找。
   Set Matches = regEx.Execute(strng)   ' 执行搜索。

   For Each mtch In Matches   ' 遍历 Matches 集合。
      RetStr = RetStr & mtch.FirstIndex & mtch.Value & vbCrLf
   Next

   RegExpTest = RetStr

   '=======测试结果(10万次循环）=========================================
    'Str1 = "Aaa"
    'Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
    '第1次 46秒  第2次 46秒  第3次 46秒

    '===================================================================End FunctionFunction Test_FindString_04(ByVal Str1 As String, ByVal Str2 As String) As Boolean
Dim Pos As Long, Pos2 As Long
Dim LenStr1 As Long, LenStr2 As LongLenStr1 = Len(Str1)
LenStr2 = Len(Str2)Pos = 0 '修改了这里
Do
    Pos = InStr(Pos + 1, Str2, Str1, vbTextCompare) '不区分大小写
    If Pos = 0 Then Exit Do '查找失败

    '判断范围
    Pos2 = Pos + LenStr1
    If Pos2 - 1 = LenStr2 Then '查找成功
        Exit Do
    ElseIf Pos2 - 1 > LenStr2 Then '查找失败
        Pos = 0
        Exit Do
    End If

    '判断“,”，注意vbKeySnapshot与AscW(",")相等，AscW是最快的asc函数
    If AscW(Mid$(Str2, Pos2, 1)) = vbKeySnapshot Then
        '查找成功
        Exit Do
    Else
        '继续循环
    End If

LoopIf Pos > 0 Then
    Test_FindString_04 = True
End If   '=======测试结果(10万次循环）=========================================
    'Str1 = "Aaa"
    'Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
    '第1次 4秒  第2次 4秒  第3次 4秒

    '===================================================================
End FunctionPrivate Function Test_FindString_05(ByVal Str1 As String, ByVal Str2 As String) As Boolean
    Dim i As Long
    Dim a() As String
    Dim nLen As Integer

    Str1 = UCase(Str1)
    nLen = Len(Str1)

    a = Split(Str2, ",")

    For i = 0 To UBound(a)
        If nLen = Len(a(i)) Then    '如果长度不相等则不用比较
            If Str1 = UCase(a(i)) Then
                Test_FindString_05 = True:      Exit Function
            End If
        End If
    Next    Erase a

    '=======测试结果(10万次循环）=========================================
    'Str1 = "Aaa"
    'Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
    '第1次 48秒  第2次 52秒  第3次 40秒

    '===================================================================

End Function

测试程序母程序如下：Private Sub Test_FindStringSpeed()
    Dim Str1 As String:         Dim i As Long
    Dim Str2 As String:         Dim bResult As Boolean
    Dim dStart As Date:         Dim dEnd As Date

    dStart = Time    Str1 = "Aaa"
    Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."

    For i = 1 To 100000
        'bResult = Test_FindString_01(Str1, Str2)
        'bResult = Test_FindString_02(Str1, Str2)
        'bResult = Test_FindString_03(Str1, Str2)
        'Call RegExpTest(Str1, Str2)
        bResult = Test_FindString_04(Str1, Str2)
        'bResult = Test_FindString_05(str1, str2)
        'bResult = Test_FindString_06(str1, str2)
    Next i

    dEnd = Time

    MsgBox DateDiff("s", dStart, dEnd)

End Sub

'=======测试结果(10万次循环）=========================================
'Str1 = "Aaa"
'Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."

'===================================================================最后的比赛成绩如下：fa7274(聂风) ：   第1次 33秒  第2次 35秒  第3次 36秒
VertyNew(华) ：   第1次 5秒  第2次 5秒  第3次 5秒
hhjjhjhj(大头)：  第1次 46秒  第2次 46秒  第3次 46秒
superdullwolf(超级大笨狼,每天要自强) ：第1次 807秒  第2次未测试
zyl910(910：分儿，我又来了！)：第1次 4秒  第2次 4秒  第3次 4秒
libralibra() ：   第1次 48秒  第2次 52秒  第3次 40秒BlueBeer(1win)：方法与VertyNew(华)类似，但BlueBeer(1win)居然使用了UCase来判断大小，此乃一大败笔，请注意Instr(1, Str2, Str1, vbTextCompare) '不区分大小写
最后的比赛结果：zyl910(910：分儿，我又来了！)获胜，但是，由于VertyNew(华)的效率也很高，并且算法也极简单，因此我郑重宣布：
zyl910(910：分儿，我又来了！)和VertyNew(华)并列第一请大家向获奖的选手表示热烈的祝贺。鼓掌

fa7274(聂风)的方法的“字母大小写”的问题，可通过用ubound()函数统一转换成大写或lbound()函数统一转换成小写解决。
dim i as long
dim a() as string
str1=ucase(str1)
strw=ucase(str2)
a=split(str2,",")
for i=0 to ubound(a)
if str1=a(i) then ...
next
但split函数需要重新分配内存，严重影响速度。VertyNew(华)的方法应该是最快的
Str1 = "Aaa"
Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
Str3 = "," & Str1 & ","
Str4 = "," & Str2 & ","
intLoc = Instr(Str3, Str4)superdullwolf(超级大笨狼,每天要自强) 的方法好象也不错，不过好象有点牛刀杀鸡了吧？
他用的是（引用 Microsoft VBScript Regular Expressions 1.0 library 对象）

谢谢VBDN(王水云)的精彩点评，superdullwolf(超级大笨狼,每天要自强) 的方法是最慢的，耗时807秒，而且结果还不准确，但不失为一种新颖的办法。另外，谢谢Fnems(Fnems) 的指教。我最后所采用的方法是在VertyNew(华)的基础上进行了一些改进，使算法的平均效率与zyl910(910：分儿的相同，改进程序如下：Private Function Test_FindString_06(ByVal Str1 As String, ByVal Str2 As String) As Boolean
    Dim intLoc As Long

    Str1 = "," & Str1 & ","

    intLoc = InStr(1, Str2, Str1, 1)

    If intLoc > 0 Then
        Test_FindString_06 = True
    Else
        Str2 = "," & Str2 & ","
        intLoc = InStr(1, Str2, Str1, 1)
        If intLoc > 0 Then
            Test_FindString_06 = True
        End If
    End If

    '=======测试结果(10万次循环）=========================================
    'Str1 = "Aaa"
    'Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
    '第1次 4秒  第2次 5秒  第3次 4秒

    '===================================================================

End Function

测试母程序应该改一改
Private Sub Test_FindStringSpeed()
    Dim Str1 As String:         Dim i As Long
    Dim Str2 As String:         Dim bResult As Boolean
    Dim dStart As Date:         Dim dEnd As Date

    dStart = Time    Str1 = "Aaa"
    Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."
    '加下面2句
     str2="," & ucase（str2） & ","
    str1="," & ucase(str1) & ","    For i = 1 To 100000
        'bResult = Test_FindString_01(Str1, Str2)
        'bResult = Test_FindString_02(Str1, Str2)
        'bResult = Test_FindString_03(Str1, Str2)
        'Call RegExpTest(Str1, Str2)
        bResult = Test_FindString_04(Str1, Str2)
        'bResult = Test_FindString_05(str1, str2)
        'bResult = Test_FindString_06(str1, str2)
    Next i

    dEnd = Time

    MsgBox DateDiff("s", dStart, dEnd)

End Sub'测试程序改进一下
Private Function Test_FindString_06(ByVal Str1 As String, ByVal Str2 As String) As Boolean
    Dim intLoc As Long

   ' Str1 = "," & Str1 & ","   ==实际应用中不会这样

   ’ intLoc = InStr(1, Str2, Str1, 1) ==改成下面的语句
    intLoc = InStr(1, Str2, Str1)

    If intLoc > 0 Then
        Test_FindString_06 = True
    'Else
    '    Str2 = "," & Str2 & ","
    '    intLoc = InStr(1, Str2, Str1, 1)
    '    If intLoc > 0 Then
    '        Test_FindString_06 = True
    '    End If
    End If测试速度大约为原来的四倍

看我的：在1.8MB的《瑜珈师地论》里查找接近末尾的"大唐内常侍轻车都尉"。编辑状态8秒左右，编译后1秒。Option ExplicitPrivate Sub Command1_Click()
  'SY2.txt为1.8MB的《瑜珈师地论》，"大唐内常侍轻车都尉"接近末尾。
  Open "SY2.txt" For Binary As #1
    Dim tBytes() As Byte
    Dim tFileSize As Long
    Dim tBytes_Length As Long

    tFileSize = LOF(1)

    tBytes_Length = tFileSize - 1

    ReDim tBytes(tBytes_Length)

    Get #1, 1, tBytes()

    Dim tString As String

    tString = StrConv(tBytes(), vbUnicode)

    Dim tOnTimer As Double
    Dim tTimerOut As Double

    tOnTimer = Timer

    Dim tInsert As Long

    tInsert = StringFind(tString, "大唐内常侍轻车都尉")

    tTimerOut = Timer - tOnTimer

    Text1.Text = tInsert & " " & tTimerOut

    '大唐内常侍轻车都尉
  Close #1
  'Text1.Text = StringFind("DDD,EEE,FFF,AAA,BBB,小仙妹,AaaF,AaaD", ",小仙妹")
End SubFunction StringFind(ByVal pString As String, ByVal pFind As String) As Long
  Dim tOutLong As Long

  Dim tStrBytes() As Byte
  Dim tStrBytes_Length As Long

  Dim tFindBytes() As Byte
  Dim tFindBytes_Sum As Long
  Dim tFindBytes_Length As Long

  Dim tFindChack As Boolean

  tStrBytes() = pString
  tFindBytes() = pFind

  tFindBytes_Length = UBound(tFindBytes())
  tStrBytes_Length = UBound(tStrBytes())

  tFindChack = tStrBytes_Length > tFindBytes_Length

  If tFindChack Then

    Dim tScanSum As Long
    Dim tScanOver As Long    tScanOver = tStrBytes_Length - tFindBytes_Length    Dim tIndex As Long

    Dim tSumCheck As Boolean
    Dim tScanCheck As Boolean

    tFindBytes_Sum = BytesSum(tFindBytes(), tFindBytes_Length)

    For tIndex = 0 To tScanOver Step 2

      If CBool(tIndex) Then
          'tScanSum = tScanSum + tStrBytes(tIndex + tFindBytes_Length - 1) - tStrBytes(tIndex - 2)
          tScanSum = tScanSum + BytesSum(tStrBytes(), 1, tIndex + tFindBytes_Length - 1) - BytesSum(tStrBytes(), 1, tIndex - 2)
        Else
          tScanSum = BytesSum(tStrBytes(), tFindBytes_Length)
      End If

      tSumCheck = tScanSum = tFindBytes_Sum

      If tSumCheck Then
        tScanCheck = BytesOnIndex(tStrBytes(), tFindBytes(), tIndex)

        If tScanCheck Then
          tOutLong = (tIndex \ 2) + 1
          Exit For
        End If      End If

    Next


  End If

  StringFind = tOutLong
End FunctionFunction BytesSum(ByRef pBytes() As Byte, ByVal pLength As Long, Optional ByVal pStart = 0) As Long
  Dim tOutLong As Long

  Dim tIndex As Long
  Dim tIndexOver As Long

  tIndexOver = pStart + pLength

  For tIndex = pStart To tIndexOver
    tOutLong = tOutLong + pBytes(tIndex)
  Next

  BytesSum = tOutLong
End FunctionFunction BytesOnIndex(ByRef pDesBytes() As Byte, ByRef pSurBytes() As Byte, ByVal pIndex) As Boolean
  Dim tOutBool As Boolean

  tOutBool = True

  Dim tSurBytes_Length As Long

  tSurBytes_Length = UBound(pSurBytes())  Dim tSurIndex As Long
  Dim tDesIndex As Long

  Dim tByteChack As Boolean

  For tSurIndex = 0 To tSurBytes_Length
    tDesIndex = tSurIndex + pIndex
    tByteChack = pDesBytes(tDesIndex) = pSurBytes(tSurIndex)
    tOutBool = tOutBool And tByteChack
  Next

  BytesOnIndex = tOutBool
End Function

不好意思，其实我的程序没有instr快。不过那是一个真正查找的算法，而不是用现成的Instr。Instr是程序本身提供的，而不是某位自己写出来的。

To chchw2001(小鱼儿):
  你把str2="," & ucase（str2） & ","
       str1="," & ucase(str1) & ","
  放到测试子程序之外（及循环体之外）就失去了“子程序”的正确性和完整性。你所更改后的Test_FindString_06对字母的大小写进行了区分，不符合本试题的原意。
  其实，你仔细体会一下Test_FindString_06的原程序，有一些奥妙的。
To KiteGirl(小仙妹):
   谢谢你的精彩算法，你将获得“精神文明奖”另外，希望大家能从个“算法题目”中总结出一些对大家都有启迪意义的心得。

我的算法是这样的：一、计算检验和的一个快速方法。1、计算校验和。将Aaa的6个字节的Ascii码相加。2、然后产生一个和Aaa一样宽的窗口（这里是6个字节），计算从N个字节开始的6个字节的校验和。这里有一个快速算法。传统算法是一次次累加从N到N+5字节。
我这里是：先计算前6个计算出SUM，然后计算SUM=SUM+NE-PR。NE是窗口的下一个字节，PR是前一个字节。例如：
1 2 3 4 5 6 7 8 9
1+2+3=6
6+4-1=2+3+4=9
9+5-2=3+4+5=121+2+3+4=10
10+5-1=2+3+4+5=14
14+6-2=3+4+5+6=18依此类推……这个算法的优点是无论窗口多宽（哪怕是100个、1000个字节），只要计算一个加法和一个减法就可以连续地得到一系列校验和。而通常的方法需要100次、1000次地加法。二、完全相等的字节序列必定包含在校验和相等的集合之内。所以，通过上面的方法快速计算出校验和，可以排除掉那些肯定不等的序列，从而判断出可能相等的序列。由于检验和相等而序列不等的序列概率不是很大，所以第一步提高了效率。
第二步则是将可能相等的序列的每个字节逐个比较，如果全部符合，则是找到了这个字符串。由于我上面的代码用VB编写，所以效率不高，速度上根本不能和InStr相比。不过，这个算法的确能在某些场合提高效率。比如：计算矩阵中，计算某点周围N*N矩阵的点的密度（比如扫雷游戏），速度是相当快的。

晕，一句代码就搞定的事，犯得着写算法？真的都比instr快？

Private Sub Test_FindStringSpeed()
    Dim Str1 As String:         Dim i As Long
    Dim Str2 As String:         Dim bResult As Boolean
    Dim dStart As Date:         Dim dEnd As Date

    dStart = Time    Str1 = "Aaa"
    Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."

    For i = 1 To 100000
        'bResult = Test_FindString_01(Str1, Str2)
        'bResult = Test_FindString_02(Str1, Str2)
        'bResult = Test_FindString_03(Str1, Str2)
        'Call RegExpTest(Str1, Str2)
        bResult = Test_FindString_04(Str1, Str2)
        'bResult = Test_FindString_05(str1, str2)
        'bResult = Test_FindString_06(str1, str2)
    Next i

    dEnd = Time

    MsgBox DateDiff("s", dStart, dEnd)
End Sub
楼主的这测试法好像有点局限性吧？str2是不是应该用个真正长的文本？
另外我在上边的帖子中有个单词错了，“fa7274(聂风)的方法的“字母大小写”的问题，可通过用ubound()函数统一转换成大写或lbound()”，其中ubound()、lbound()函数应该为ucase()、lcase()函数。

To VBDN(王水云:
  只要使用了ucase()、lcase()函数则数据肯定会慢许多。
  另外，“str2是不是应该用个真正长的文本？”
  即使str2使用真正的文本，Str2的项目个数绝大多数情况下应该在200个以内，Str2的长度应该在12*200以内。所以以上的测试基本上能反映真实情况。当然，如果Str2是超大型文本，则以上的一些算法可能需要重新优化。

大家写的这些代码很难称为算法。　　算法不仅仅是指程序代码。最重要的是给出实现的过程和方法。
　　稍微学过数据结构和算法的人都知道，衡量算法的优劣要从时间复杂度（大O符号）和空间复杂度（大S符号）来综合评论（空间复杂度不用过多讨论，但写代码时一定要注意。程序设计教材中给出的排序程序，里面除了数组以外只用了两三个辅助变量用来控制和交换数据，而不是另外开辟数组，就是考虑了空间复杂度。）。
　　评论某一个具体算法时，也要考虑最有利数据和最不利数据、噪音数据（也叫随机数据，普通数据情况）三种情况的复杂度。因为他们的时间复杂度一般是不同的。比如原始的直接排序算法，如果我没记错的话，最优数据，就是数据本身有序，时间复杂度是线性阶O（n），而最不利数据，即数据倒序出现时，时间复杂度是二次方阶O（n^2）。
　　像楼主一样用计算机时钟来衡量算法是不可取的。这样不利于在理论上分析两种不同的算法的优劣。而且计算时间要受到种种因素的影响，比如当时的CPU占用率等。另外，对于同一组数据，或许总体并不是最优的算法执行的很快。（也就是说碰到了这个算法拿手的数据。）
　　还有，严格来讲，算法不允许使用系统给出的函数（大家大多都用到了，比如instr和ucase）。因为我们（一般）不知道系统函数的算法如何，也就无法分析这个含有未知算法的算法。instr函数本身应该是使用优化过的算法。如果用优化的查找算法写查找算法，就相当于把压缩文件又压缩了一遍，没有什么意义，反而可能增加了复杂度。

算法中是不存在字符串这个数据类型的，学过C的人都知道。用到字符串时，要用字符数组来实现。在算法学中，控制“字符串”的种种函数当然也要自己编写。我记得去年学数据结构学到“堆和串”时，见到了一个字符串查找的算法讨论。里面有个算法K?E算法，忘了具体名字，很经典。另外我真诚希望楼主去买一本清华大学的《数据结构和算法》好好学一下，再发这种讨论算法的帖子。

我也测一下：Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim Str1 As String
Dim Str2 As StringPrivate Sub Form_Click()
Dim i As Long
Dim tt As Long
tt = GetTickCount()
For i = 0 To 100000
    Call Test_FindString_04(Str1, Str2)
Next i
tt = GetTickCount() - tt
Debug.Print tt
End SubPrivate Sub Form_Load()
    Str1 = "Aaa"
    Str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD,AaAa,aaa"
End SubFunction Test_FindString_04(ByVal Str1 As String, ByVal Str2 As String) As Boolean
Dim Pos As Long, Pos2 As Long
Dim LenStr1 As Long, LenStr2 As LongLenStr1 = Len(Str1)
LenStr2 = Len(Str2)Pos = 0 '修改了这里
Do
    Pos = InStr(Pos + 1, Str2, Str1, vbTextCompare) '不区分大小写
    If Pos = 0 Then Exit Do '查找失败

    '判断范围
    Pos2 = Pos + LenStr1
    If Pos2 - 1 = LenStr2 Then '查找成功
        Exit Do
    ElseIf Pos2 - 1 > LenStr2 Then '查找失败
        Pos = 0
        Exit Do
    End If

    '判断“,”，注意vbKeySnapshot与AscW(",")相等，AscW是最快的asc函数
    If AscW(Mid$(Str2, Pos2, 1)) = vbKeySnapshot Then
        '查找成功
        Exit Do
    Else
        '继续循环
    End If

LoopIf Pos > 0 Then
    Test_FindString_04 = True
End IfEnd Function' 1594
' 1518
' 1552
---------------------------------------------------------------------------------Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim str1 As String
Dim str2 As String
Dim regEx As RegExp   ' 建立正则表达式。Private Sub Form_Click()
Dim i As Long
Dim tt As Long
Set regEx = New RegExp
regEx.IgnoreCase = True   ' 设置不区分大小写。tt = GetTickCount()
For i = 0 To 100000
    Call RegExpTest(str1, str2)
Next i
tt = GetTickCount() - tt
Debug.Print tt
End SubPrivate Sub Form_Load()
    str1 = "Aaa"
    str2 = "DDD,EEE,FFF,AAA,BBB,AaaF,AaaD,AaAa,aaa"
End SubPrivate Function RegExpTest(ByVal str1 As String, ByVal str2 As String) As Boolean


   regEx.Pattern = str2   ' 设置模式。

   RegExpTest = regEx.Test(str1)
End Function' 470
' 463
' 460 正则表达式搜索过程本身快得多。问题是不可将创建对象放在函数内部。这就好像是先花很多钱建立一个高级的机器，以后加工成本就很低。

先将"DDD,EEE,FFF,AAA,BBB,AaaF,AaaD..."中的","替换为","(小写)，根据","用split拆分到数组中，然后判断数组中每一个元素，结果应该是对的，速度就不清楚了

to Fnems(Fnems)
    “instr函数本身应该是使用优化过的算法。如果用优化的查找算法写查找算法，就相当于把压缩文件又压缩了一遍，没有什么意义，反而可能增加了复杂度。”请问你一句，你就那么迷信微软？to 楼主
    我个人认为，str2即使不是长文本，你的测试母程序也肯定有问题。
    经我测试，Str2的长度在6*200时，Test_FindString_04（zyl910：分儿，我又来了！)函数获得了最差的表现；
    而Str2在6*50时，Test_FindString_01（fa7274聂风) 函数的表现仅次于Test_FindString_02（VertyNew(华)。
    of123() 说的对，“正则表达式搜索过程本身快得多。问题是不可将创建对象放在函数内部。这就好像是先花很多钱建立一个高级的机器，以后加工成本就很低。”
    在所有的方法中，无论从从时间复杂度还是空间复杂度，以及算法的繁简程度来考虑，VertyNew(华)的方法堪称第一，不信你再试试！各位朋友不妨也亲自来测试一下。
    在吸取了大家的经验后，我也写了一个函数，程序如下：
Private Function Test_FindString_VBDN(ByVal Str1 As String, ByVal Str2 As String) As Boolean
    Dim Pos1 As Long
    Dim Pos2 As Long
    Dim LenStr1 As Long
    Dim LenStr2 As Long
    Str1 = LCase(Str1)
    Str2 = Str2 & ","
    LenStr1 = Len(Str1)
    LenStr2 = Len(Str2)
    Test_FindString_VBDN = False
    Do
        Pos2 = InStr(Pos1 + 1, Str2, ",", vbBinaryCompare)
        If Pos2 = 0 Then Exit Do
        If Pos2 - Pos1 = LenStr1 + 1 Then
            If LCase(Mid(Str2, Pos1 + 1, LenStr1)) = Str1 Then
'               Debug.Print "找到！,位于", Pos1 + 1
                Test_FindString_VBDN = True
                Exit Do
            Else
                Pos1 = Pos2
            End If
        Else
            Pos1 = Pos2
        End If
    Loop
End Function    用楼主的测试母程序测试，它较VertyNew(华)的函数Test_FindString_02没有快多少，结果如下：
-----------------------------------------------------
Test_FindString_02：      11，12，12（秒）
Test_FindString_VBDN：     9，10，10（秒）
-----------------------------------------------------
    继续使用楼主的测试母程序测试，而将搜索内容str1改为“Aaad”时的测试结果如下：
-----------------------------------------------------
Test_FindString_02：      11，12，12（秒）
Test_FindString_VBDN：     3， 3， 3（秒）
-----------------------------------------------------
    各位朋友，看出其中的奥妙来了么？
    希望有更好更快的代码出现！

万分感谢楼主的问题和大家的努力！这个技术，将会用在我的自动拼音转换控件AutoPY.OCX里，一定会提速不少啊！

To Fnems(Fnems):
我所说的算法并不是指纯粹的“数学算法，纯粹的“数学算法”肯定不会用VB来写，我会用fortran或C来写的。我所说的算法其实是指最简单最高效的“代码解决方案”To: VBDN(王水云)
谢谢你的参与，希望大家都能从中总结出有用的东西。

不错收藏感觉测试中
Private Function Test_FindString_02(ByVal Str1 As String, ByVal Str2 As String)
Private Function Test_FindString_02(Str1 As String, Str2 As String)
是不一样的，按地址传递是不是快点，应该少了创建副本的时间。

czw1975(塞饭):
按地址传是要快一些，但但地址传非常危险，容易出错，在编程中不要轻易按地址传。

用长字符串对主要程序进行了重新测试：Str1 = "Aaa"

Str2= "DDD,EEE,FFF,GGG,HHH,III,JJJ,KKK,LLL,MMM,NNN,OOO,PPP,QQQ,RRR,SSS,TTT,UUU,VVV,ZZZ,"Str2 = Str2 & Str2 & "AAA,BBB,AaaF,AaaD..." & Str2 & Str2
'=======测试结果(10万次循环）=========================================
Test_FindString_VBDN：第1次 44秒  第2次 43秒  第3次 43秒
Test_FindString_02：第1次 32秒  第2次 33秒  第3次33秒
Test_FindString_04：第1次 31秒  第2次 31秒  第3次 31秒
======================================================================最后的比赛结果：
中国选手：zyl910(910：分儿，我又来了！)和VertyNew(华)并列第一

回复人： VBDN(王水云) ( ) 信誉：100  2004-8-30 15:57:31  得分: 0

to Fnems(Fnems)
    “instr函数本身应该是使用优化过的算法。如果用优化的查找算法写查找算法，就相当于把压缩文件又压缩了一遍，没有什么意义，反而可能增加了复杂度。”请问你一句，你就那么迷信微软？
'------------------------------------如果微软用了复杂的算法实现instr，那你再用他来完成一个需要优化的算法，不就更蠢了吗？

调试易

求最快的字符串查找算法，分只给算法效率最高的那位。

解决方案 »