在excel中加快循环
我有一些很好的帮助，让这个search工具在Excel中工作，但我想知道是否有提高速度的空间。 我做了一些研究，并与我对VB的了解我= LBOUND（arrays）对于UBOUND（arrays）似乎最优化。 会'为每个'更快？ 我想知道是否有办法隔离当前工作表中的logging，或者如果它已经与L / UBOUND这样做？ 如果是这样，是否有办法做'忽略特殊字符'类似于SQL？ 在添加屏幕更新和计算之后，我可以在整个运行时间内减less约10秒。 另外我在这个新循环之前使用了FormulaR1C1来进行search，并且在超快的时候会限制要search的列的数量。
Range("W2:W" & LastRow).FormulaR1C1 = _ "=IF(ISERR(SEARCH(R1C23,RC[-22]&RC[-21]&RC[-20]&RC[-19]&RC[-18]&RC[-17]&RC[-16]&RC[-15]&RC[-15]&RC[-14]&RC[-13]&RC[-12]&RC[-11]&RC[-10]&RC[-9]&RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1])),0,1)" If WorksheetFunction.CountIf(Columns(23), 1) = 0 Then Columns(23).Delete 任何帮助或build议，不胜感激。
Sub FindFeature() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim shResults As Worksheet Dim vaData As Variant Dim i As Long, j As Long Dim sSearchTerm As String Dim sData As String Dim rNext As Range Dim v As Variant Dim vaDataCopy As Variant Dim uRange As Range Dim findRange As Range Dim nxtRange As Range Dim ws As Range 'Put all the data into an array vaData = ActiveSheet.UsedRange.Value 'Get the search term sSearchTerm = Application.InputBox("What are you looking for?") 'Define and clear the results sheet Set shResults = ActiveWorkbook.Worksheets("Results") shResults.Range("A3").Resize(shResults.UsedRange.Rows.Count, 1).EntireRow.Delete Set uRange = ActiveSheet.UsedRange vaData = uRange.Value vaDataCopy = vaData For Each v In vaDataCopy v = Anglicize(v) Next Application.WorksheetFunction.Transpose (vaDataCopy) ActiveSheet.UsedRange.Value = vaDataCopy 'Loop through the data Set ws = Cells.Find(What:=uRange, After:="ActiveCell", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not ws Is Nothing Then Set findRange = ws Do Set nxtRange = Cells.FindNext(After:=ws) Set findRange = nxtRange Loop Until ws.Address = findRange.Address ActiveSheet.UsedRange.Value = vaData 'Write the row to the next available row on Results Set rNext = shResults.Cells(shResults.Rows.Count, 1).End(xlUp).Offset(1, 0) rNext.Resize(1, uRange(vaData, 2)).Value = Application.Index(vaData, i, 0) 'Stop looking in that row after one match End If Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
最终，这里的执行速度受到在该范围内每个单元操作的明显要求的严重阻碍，并且由于您询问性能，我怀疑这个范围可能包含数千个单元。 有两件事我可以想到：
1.将结果保存在一个数组中，并以一个语句写入结果工作表
尝试replace这个：
'Write the row to the next available row on Results Set rNext = shResults.Cells(shResults.Rows.Count, 1).End(xlUp).Offset(1, 0) rNext.Resize(1, UBound(vaData, 2)).Value = Application.Index(vaData, i, 0) 'Stop looking in that row after one match Exit For
用一个将值Application.Index(vaData, i, 0)赋值给数组variables的语句，然后当您完成For i循环时，可以将结果一次写入结果工作表。
注意当且仅当有成千上万的结果时，这可能会明显加快。 如果只有很less的结果，那么效率的提高主要是由迭代每个单元格的需要，而不是将结果写入另一个表格的操作。
2.使用另一种方法，而不是单元格迭代
如果你可以实现这个方法，我会和上面一起使用它。
通常我会build议使用.Find和.FindNext方法比使用i,j迭代更有效。 但是，由于您需要在范围内的每个单元格上使用Anglicize UDF，因此您需要对代码进行一些调整以适应。 可能需要多个循环，例如，首先对vaData并保留非vaData数据的副本，如：
Dim r as Long, c as Long Dim vaDataCopy as Variant Dim uRange as Range Set uRange = ActiveSheet.UsedRange vaData = uRange.Value vaDataCopy = vaData For r = 1 to Ubound(varDataCopy,1) For c = 1 to Ubound(varDataCopy,2) varDataCopy(r,c) = Anglicize(varDataCopy(r,c)) Next Next
然后，将Anglicize版本放在工作表上。
ActiveSheet.UsedRange.Value = vaDataCopy
然后，而不是For i =... For j =...循环，使用uRange对象上的.Find和.FindNext方法。
这里是我如何实现Find / FindNext的一个例子 。
最后，将非英语版本放回到工作表中，再次提醒您可能需要使用Transpose函数：
ActiveSheet.UsedRange.Value = vaData
这仍然遍历每个值来执行Anglicize函数，它不会再对每个值（ Instr函数）进行操作。 所以，你基本上只对值进行一次操作，而不是两次。 我怀疑这应该更快，特别是如果你把它与上面的＃1结合。
基于OP修订工作的更新
经过一些评论讨论和邮件来回，我们到达这个解决scheme：
Option Explicit Sub FindFeature() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim shSearch As Worksheet: Dim shResults As Worksheet Dim vaData As Variant Dim i As Long, j As Long, r As Long, c As Long Dim sSearchTerm As String Dim sData As String Dim rNext As Range Dim v As Variant Dim vaDataCopy As Variant Dim uRange As Range Dim findRange As Range Dim nxtRange As Range Dim rng As Range Dim foundRows As Object Dim k As Variant Set shSearch = Sheets("City") shSearch.Activate 'Define and clear the results sheet Set shResults = ActiveWorkbook.Worksheets("Results") shResults.Range("A3").Resize(shResults.UsedRange.Rows.Count, 1).EntireRow.Delete '# Create a dictionary to store our result rows Set foundRows = CreateObject("Scripting.Dictionary") 'Get the search term sSearchTerm = Application.InputBox("What are you looking for?") '# set and fill our range/array variables Set uRange = shSearch.UsedRange vaData = uRange.Value vaDataCopy = Application.Transpose(vaData) For r = 1 To UBound(vaDataCopy, 1) For c = 1 To UBound(vaDataCopy, 2) 'MsgBox uRange.Address vaDataCopy(r, c) = Anglicize(vaDataCopy(r, c)) Next Next '# Temporarily put the anglicized text on the worksheet uRange.Value = Application.Transpose(vaDataCopy) '# Loop through the data, finding instances of the sSearchTerm With uRange .Cells(1, 1).Activate Set rng = .Cells.Find(What:=sSearchTerm, After:=ActiveCell, _ LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not rng Is Nothing Then Set findRange = rng Do Set nxtRange = .Cells.FindNext(After:=findRange) Debug.Print sSearchTerm & " found at " & nxtRange.Address If Not foundRows.Exists(nxtRange.Row) Then '# Make sure we're not storing the same row# multiple times. '# store the row# in a Dictionary foundRows.Add nxtRange.Row, nxtRange.Column End If Set findRange = nxtRange '# iterate over all matches, but stop when the FindNext brings us back to the first match Loop Until findRange.Address = rng.Address '# Iterate over the keys in the Dictionary. This contains the ROW# where a match was found For Each k In foundRows.Keys '# Find the next empty row on results page: With shResults Set rNext = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0). _ Resize(1, UBound(Application.Transpose(vaData), 1)) End With '# Write the row to the next available row on Results rNext.Value = Application.Index(vaData, k, 0) Next Else: MsgBox sSearchTerm & " was not found" End If End With '# Put the non-Anglicized values back on the sheet uRange.Value = vaData '# Restore application properties Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True '# Display the results shResults.Activate End Sub Public Function Anglicize(ByVal sInput As String) As String Dim vaGood As Variant Dim vaBad As Variant Dim i As Long Dim sReturn As String Dim c As Range 'Replace any 'bad' characters with 'good' characters vaGood = Split("S,Z,s,z,Y,A,A,A,A,A,A,C,E,E,E,E,I,I,I,I,D,N,O,O,O,O,O,U,U,U,U,Y,a,a,a,a,a,a,c,e,e,e,e,i,i,i,i,d,n,o,o,o,o,o,u,u,u,u,y,y", ",") vaBad = Split("Š,Ž,š,ž,Ÿ,À,Á,Â,Ã,Ä,Å,Ç,È,É,Ê,Ë,Ì,Í,Î,Ï,Ð,Ñ,Ò,Ó,Ô,Õ,Ö,Ù,Ú,Û,Ü,Ý,à,á,â,ã,ä,å,ç,è,é,ê,ë,ì,í,î,ï,ð,ñ,ò,ó,ô,õ,ö,ù,ú,û,ü,ý,ÿ", ",") sReturn = sInput Set c = Range("D1:G1") For i = LBound(vaBad) To UBound(vaBad) sReturn = Replace$(sReturn, vaBad(i), vaGood(i)) Next i Anglicize = sReturn 'Sheets("Results").Activate End Function