Double FOR循环需要一段时间才能完成

问题描述：

我需要比较不同工作表中的2个单元格，并在出现匹配时获取值。我目前有这段代码，它列B中的每个单元格被检查到列A中的每个单元格，并且如果存在匹配，C列中的相应单元格被复制。问题在于，这么好，需要很长时间才能完成。我只有B列中的750条记录和A列中的4000条记录。Double FOR循环需要一段时间才能完成

有没有方法可以优化代码，使其运行速度更快？

For i = 2 To LastRow 
    For j = 2 To LastRowJ 
     If Sheets("tempsheet").Range("B" & i).Value = Sheets("tempsheet").Range("A" & j).Value Then 
      Range("Q" & i).Value = Sheets("tempsheet").Range("C" & j).Value 
     End If 
    Next j 
Next i

在循环中使用find而不是另一个循环。 – MatthewD

答

这里有6次测量：

1. copyValsCell1(): 90.78125 sec (posted code) 
2. copyValsCell2(): 53.27343 sec (ws object) 
3. copyValsCell3(): 52.67187 sec (With statement, and screen off) 

4. copyValsArr():  0.60937 sec (Array - no restrictions) 

5. copyValsDictCell(): 0.07812 sec (Dictionary with Range - unique values only) 
6. copyValsDictArr(): 0.03125 sec (Dictionary with Array - unique values only)

在我的测试文件，我公顷d在同一张纸上的所有值（lr = 4000: lrj = 750）

。

初始代码 - Duration copyValsCell1(): 90.78125 sec

WS对象

Set ws = Sheets("tempsheet") 
For i = 2 To lr        'Duration copyValsCell2(): 53.2734375 sec 
    For j = 2 To lrj 
     If ws.Range("B" & i).Value = ws.Range("A" & j).Value Then 
      ws.Range("Q" & i).Value = ws.Range("C" & j).Value 
     End If 
    Next 
Next

With语句，以及屏幕关闭

Set ws = Sheets("tempsheet") 
Application.ScreenUpdating = False 
For i = 2 To lr        'Duration copyValsCell3(): 52.671875 sec 
    For j = 2 To lrj 
     With ws 
      If .Range("B" & i).Value2 = .Range("A" & j).Value2 Then 
       .Range("Q" & i).Value2 = .Range("C" & j).Value2 
      End If 
     End With 
    Next 
Next 
Application.ScreenUpdating = True

阵列

Dim v As Variant 
v = Sheets("tempsheet").Range("A1:Q4000") 
For i = 2 To lr        'Duration copyValsArr(): 0.609375 sec 
    For j = 2 To lrj 
     If v(i, 2) = v(j, 1) Then v(i, 17) = v(j, 3) 
    Next 
Next 
Sheets("tempsheet").Range("A1:Q4000") = v

字典与范围（需要参照Microsoft脚本运行时库）

Set d = New Dictionary: Set ws = Sheets("tempsheet") 
For i = 2 To lrj       'Duration copyValsDictCell(): 0.078125 sec 
    d(ws.Range("A" & i).Value2) = i 
Next 
For i = 2 To lr 
    If d.Exists(ws.Range("B" & i).Value) Then 
     ws.Range("Q" & i).Value = ws.Range("C" & d(ws.Range("B" & i).Value)).Value 
    End If 
Next

字典与阵列（需要参考Microsoft脚本运行时库）

Dim v As Variant 
v = Sheets("tempsheet").Range("A1:Q4000") 
Set d = New Dictionary      'Duration copyValsDictArr(): 0.03125 sec 
For i = 2 To lrj 
    d(v(i, 1)) = i 
Next 
For i = 2 To lr 
    If d.Exists(v(i, 2)) Then v(i, 17) = v(d(v(i, 2)), 3) 
Next 
Sheets("tempsheet").Range("A1:Q4000") = v

开始=>

有趣的比较。我怀疑字典会因为一个很大的因素而变得更好，但是却发现原始代码的低效性可追溯到范围访问中令人惊讶。 –

我想现在已经成为众所周知的与范围的交互效率不高，除非你真的需要复制格式;但是试图完成简单任务的人可能对数组和字典的概念有点不情愿，所以我试图说明让这些任务更容易扩展而不费吹灰之力是多么的简单。（我做了一个类似的比较[在这个答案]（http://codereview.stackexchange.com/a/101529/75176）） –

@ paulbica，对于我的回复延迟抱歉。我试图运行代码（选项4），然后出现错误：Expected Array。我想我需要调用一些东西作为一个数组？ – CustomX

答

尝试这种情况：

For i = 2 To LastRow 
    Set match_check = Sheets("tempsheet").Range("A:A").Find(Sheets("tempsheet").Range("B" & i), Lookat:=xlWhole) 
    If Not match_check Is Nothing Then Range("Q" & i) = match_check.Offset(0,2) 
Next i

Find如果没有发现匹配返回列和第一找到的匹配Nothing的Range对象。我没有检查运行时间，但它应该比double for循环更快。

答

你可以使用在A列键入到值的字典 - 假设这些值是完全不同的（否则你的代码本身并不完全意义包括通过Tools/References在参考Microsoft脚本运行（。。VBA编辑器）下面的代码应该是超过100倍的速度你目前有：

Sub test() 
    Dim LastRow As Long, LastRowJ As Long 
    Dim i As Long, j As Long 
    Dim AVals As New Dictionary 

    LastRow = Sheets("tempsheet").Cells(Rows.Count, "B").End(xlUp).Row() 
    LastRowJ = Sheets("tempsheet").Cells(Rows.Count, "A").End(xlUp).Row() 
    For j = 2 To LastRowJ 
     AVals.Add Sheets("tempsheet").Range("A" & j).Value, j 
    Next j 
    For i = 2 To LastRow 
     If AVals.Exists(Sheets("tempsheet").Range("B" & i).Value) Then 
      j = AVals(Sheets("tempsheet").Range("B" & i).Value) 
      Range("Q" & i).Value = Sheets("tempsheet").Range("C" & j).Value 
     End If 
    Next i 
End Sub

Double FOR循环需要一段时间才能完成

相关推荐