Excel VBA查找function需要很长时间
我已经写了一个简短的函数，用Excel工作簿中的另一组stringsearch一组string。 function如下：
Function CheckForString(Target As Range, List As Range) Application.ScreenUpdating = False Dim Output As String Output = "No Match" For Each Item In List If Output = "No Match" Then If Not Target.Find(Item.Value) Is Nothing Then Output = Item.Value End If Next CheckForString = Output Application.ScreenUpdating = True End Function 问题是我正在使用这个函数在大约2000个其他string中search大约40万个string。 我已经设置好了，让它运行几个小时，而且还没有完成计算。
所以在工作表中有40万个= CheckForString（）的实例，他们在一个〜2,000个单元格范围内循环。 我所要做的就是看看是否有任何一个string出现在每个400,000个单元格中。 例如：
string：“APPLES-BANANAS 123459”
stringfind：
苹果对香蕉
应用香蕉
所以如果它在第一个“打”，我不在乎是否再发现。 我只需要知道，至less有一个stringfind在那里。
感谢有关如何加快速度的任何想法！
最好，
Grrollins
编辑：到目前为止在评论中的问题（并感谢您花时间！）
我正在search的数据是包含序列号（字母数字）的string，但没有一致的格式，并包含额外的垃圾，空白，其他字符等。
我有一套原始的序列号，我试图比较大的数据转储。 我们的目标是确定大集合中的哪些string包含一个string，该string可能是我列表中的序列号，所以我可以进一步查看这些logging并使用它们创build报告。
我希望能让它更清楚一点！ 再次感谢！
我也会尝试退出。 如果有的话，也许它会刮几个小时！
子程序MarkStrings将以绿色突出显示来自Target所有string，其中包含来自List范围的子string。
主要观点：
- 以“简单的数据结构”工作在“堆栈内存”上;
- 避免重复转换相同的项目;
- 使用
Strings函数，而不是WorksheetFunction函数（也， 方式更快）。
当然，你可以重新deviseSub来做你想做的事情。 请注意， 这与您的Function 不一样 。 虽然你的函数被调用了很多单元，但是这个子例程应该被调用一次，对于所有的Target范围，参见Test()子例程。
Public Sub Test() Call MarkStrings(Sheet1.Range("C3:DG303"), Sheet1.Range("A1:B2")) End Sub Public Sub MarkStrings( _ ByVal Target As Range, _ ByVal List As Range _ ) Dim raw As Variant Dim str_target() As String Dim str_list() As String Dim m As Long, m_min As Long, m_max As Long Dim n As Long, n_min As Long, n_max As Long Dim p As Long, p_min As Long, p_max As Long Dim q As Long, q_min As Long, q_max As Long ' 0. Check ranges ' If (Target Is Nothing) Or (List Is Nothing) Then Exit Sub End If Let Application.ScreenUpdating = False ' 1. Load the entire Target in memory, and make it string ' Let raw = Target.Value Let m_min = LBound(raw, 1) Let m_max = UBound(raw, 1) Let n_min = LBound(raw, 2) Let n_max = UBound(raw, 2) ReDim str_target( _ m_min To m_max, _ n_min To n_max _ ) For m = m_min To m_max For n = n_min To n_max Let str_target(m, n) = CStr(raw(m, n)) Next n Next m Let raw = Empty ' 2. Load the entire List in memory, and make it string ' Let raw = List.Value Let p_min = LBound(raw, 1) Let p_max = UBound(raw, 1) Let q_min = LBound(raw, 2) Let q_max = UBound(raw, 2) ReDim str_list( _ p_min To p_max, _ q_min To q_max _ ) For p = p_min To p_max For q = q_min To q_max Let str_list(p, q) = CStr(raw(p, q)) Next q Next p Let raw = Empty ' 3. Loop trough Target and check elements in List. If found, ' ' make cell background green and go to next target. ' For m = m_min To m_max For n = n_min To n_max For p = p_min To p_max For q = q_min To q_max If Strings.InStr( _ Start:=1, _ String1:=str_target(m, n), _ String2:=str_list(p, q), _ Compare:=vbTextCompare _ ) > 0 Then Let Target.Cells(m, n).Interior.Color = vbGreen GoTo NEXT_TARGET End If Next q Next p NEXT_TARGET: Next n Next m Let Application.ScreenUpdating = True End Sub
search约4个string的范围。 300×100在我的机器上花了一秒钟。 你的情况应该是（400000×2000）/（4×30000）〜= 6700秒〜= 2小时。
Appologies，但我不明白，为什么我们不使用range.find方法。 场景是目标范围可能有4,00,000行，需要search近2000行。 使用find循环将只有2000次。 并且只会在几秒钟内得到结果，代码会更快
Function myfind(targetrng As Range, sourcerng As Range) On Error Resume Next Dim c As Range Dim cell As Range Set c = targetrng.Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext) If c Is Nothing Then myfind = "No Match" Else myfind = "Match Found" End If End Function