使用嵌套for循环和数组比较提高效率

我有一个macros循环两张纸，比较每个单元格中的单词。 代码工作正常，但有没有办法来提高效率或速度呢？ 我手动使用for循环来比较string数组，因为我没有find任何VBA函数来做到这一点。 我确实有ScreenUpdating，这似乎有所帮助。

For i = 2 To maxMn 'loop 1 Sheets("Sh1").Select Cells(i, 2).Select mnStr = Cells(i, 2).Value mnArr = Split(mnStr, " ") x = 2 For x = 2 To maxNm 'loop 2 numTotal = 0 numMatches = 0 Sheets("Sh2").Select Cells(x, 6).Select nameStr = Cells(x, 6).Value nameArr = Split(nameStr, " ") For Each mn In mnArr 'loop 3 For Each nam In nameArr 'loop 4 Application.StatusBar = "(#" & i & " Sh1) (#" & x & " Sh2): Comparing " & mn & " to " & nam If LCase(nam) = LCase(mn) Then 'MsgBox "Yes, '" & nam & "' equal to " & mn numMatches = numMatches + 1 Else 'MsgBox "No, '" & nam & "' does not equal " & mn End If Next nam '4: For Each nam In nameArr numTotal = numTotal + 1 Next mn '3: For Each mn In mnArr If numTotal > 2 And numTotal > 0 And numMatches >= numTotal / 2 Then LogMsg = "(#" & i & " Sh1) (#" & x & " Sh2): |" & mnStr & "| - |" & nameStr & "| = " & numMatches & "/" & numTotal & " matches." Print #FileNum, LogMsg 'MsgBox numMatches & " matches out of " & numTotal & " total." End If Next x '2: For x = 2 To maxNm Next i '1: For i = 2 To maxMn 

Answer 1

这个网站有很好的提升性能​​的提示。 在你的情况下，避免循环的单元格; 相反，将内容存储在一个数组中，并在数组上循环。 这应该会显着提高性能。

你的代码的开头看起来像这样（我已经注释掉你的原始代码）：

 Dim sheet1 As Variant Dim sheet2 As Variant With Sheets("Sh1") sheet1 = .Range(.Cells(1, 2), .Cells(maxMn, 2)) End With With Sheets("Sh2") sheet2 = .Range(.Cells(1, 6), .Cells(maxNm, 6)) End With For i = 2 To maxMn 'loop 1 'Sheets("Sh1").Select 'Cells(i, 2).Select 'mnStr = Cells(i, 2).Value mnStr = sheet1(i, 1) mnArr = Split(mnStr, " ") x = 2 For x = 2 To maxNm 'loop 2 numTotal = 0 numMatches = 0 'Sheets("Sh2").Select 'Cells(x, 6).Select 'nameStr = Cells(x, 6).Value nameStr = sheet2(x, 1) nameArr = Split(nameStr, " ") For Each mn In mnArr 'loop 3 

你也可以改善文件输出：

 Dim i As Long Dim fileName As String Dim fileContent As String i = FreeFile fileName = "xxxxxx" fileContent = "yyyyyyy" 'you can call your main function here and return a string If Dir(fileName) <> "" Then Kill (fileName) 'If you want to override existing file Open fileName For Binary Lock Read Write As #i Put #i, , fileContent 

Answer 2

提高效率的第一条原则是不要select或激活任何东西。 对于分别有300行和200行的数据集，您的代码需要13.5分钟。 只是删除select

  For i = 2 To maxMn 'loop 1 'Sheets("Sh1").Select 'Cells(i, 2).Select mnStr = Sheets("Sh1").Cells(i, 2).Value mnArr = Split(mnStr, " ") x = 2 For x = 2 To maxNm 'loop 2 numTotal = 0 numMatches = 0 'Sheets("Sh2").Select 'Cells(x, 6).Select nameStr = Sheets("Sh2").Cells(x, 6).Value 

把时间缩短到154秒。 屏幕重绘是单个最大的时间接收器。 下面的代码运行时间为2.18秒（5.6秒，如果添加状态栏更新 – 如果只需要2秒，则不需要）

 Sub CompareWords2() Dim vaNam As Variant, vaMn As Variant Dim i As Long, j As Long Dim vaSplitNam As Variant, vaSplitMn As Variant Dim colUnique As Collection Dim lWord As Long Dim sLog As String Dim lMatches As Long, lTotal As Long Dim sgStart As Single sgStart = Timer 'Put both ranges in an array With ThisWorkbook.Sheets("Sh1") vaMn = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value End With With ThisWorkbook.Sheets("Sh2") vaNam = .Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp)).Value End With For i = LBound(vaMn, 1) To UBound(vaMn, 1) For j = LBound(vaNam, 1) To UBound(vaNam, 1) 'put all the first words in a collection vaSplitMn = Split(vaMn(i, 1), Space(1)) Set colUnique = New Collection For lWord = LBound(vaSplitMn) To UBound(vaSplitMn) colUnique.Add vaSplitMn(lWord), LCase(CStr(vaSplitMn(lWord))) Next lWord 'add all the next words to the collection to remove duplicates vaSplitNam = Split(vaNam(j, 1), Space(1)) For lWord = LBound(vaSplitNam) To UBound(vaSplitNam) On Error Resume Next colUnique.Add vaSplitNam(lWord), LCase(CStr(vaSplitNam(lWord))) On Error GoTo 0 Next lWord 'Write to log lMatches = UBound(vaSplitMn) + UBound(vaSplitNam) + 2 - colUnique.Count lTotal = UBound(vaSplitMn) + 1 If lMatches >= lTotal / 2 Then sLog = sLog & "(#" & i & " Sh1) (#" & j & " Sh2): |" & vaMn(i, 1) & "| - |" & vaNam(j, 1) & "| = " sLog = sLog & lMatches & "/" & lTotal & " matches." & vbNewLine End If Next j Next i 'post total log all at once Open ThisWorkbook.Path & Application.PathSeparator & "CompareLog2.txt" For Output As #1 Print #1, sLog Close #1 Debug.Print Timer - sgStart End Sub 

Answer 3

这里是一个指针列表，使其更有效率

1. 不要访问循环内的单元格。 使用vals = Range("A2").Resize(N,1).Value将单元格分配到数组variables中vals = Range("A2").Resize(N,1).Value属性并使用vals(i,j)访问值。 最后，您可以使用Range("A2").Resize(N,1).Value = vals将值写回到电子表格中Range("A2").Resize(N,1).Value = vals
2. 不要在循环内逐行写入文件。 写入一个string，然后在一个操作中将整个string写入一个文件
3. 通过写入状态栏和进度条来最小化改变屏幕的使用。 closures更新与Application.ScreenUpdating = False或只是省略代码。 如果需要，也许只有每100次迭代，例如更新UI。

看看这个答案的例子，如何使用.Value地同时读写多个单元格。