在工作表之间search行时的空闲时间

我写了一些需要花费太多时间计算的代码。

它从工作表（Plan1，具有11,617行，在第二行开始数据）“刷”特定列中的行，查找单元格的值，存储此值，search第二个工作表中的特定列中的每一行（Plan2 ，有158,715行，也在第二行开始数据），并validation遇到的值是否与search值匹配。 如果为true，则将该值存储起来，然后将其分配给以前工作表（Plan1）中未使用的单元格，但在新列中处于同一行。 它可以工作，但是由于行数很大，在Plan1中完成每个列大约需要1个小时。

有一次，我试图使用VLOOKUP，花费很less的时间（大约5分钟），但数据奇怪地损坏，所以我开始使用VBA编程来获得更多的数据准确性。 我抬头看这个问题 ，但是我的问题比答案的解释太具体。 为了更好的理解，我翻译了代码，所以如果你注意到一个语法错误，别担心， 此代码在翻译之前正在工作。

最后，这是我的代码。

Sub AddAddress() Dim Plan1, Plan2 As Worksheet Dim FirstRow As Long Dim LastRow As Long Dim CurrentRow As Long Dim CalcMode As Long Dim ViewMode As Long Dim SoughtId, EncounteredId, Address As String Dim SuccessCounter As Integer Dim StartTime, EndTime, ElapsedTime As Date StartTime = Time() Set Plan1 = Application.Worksheets("Plan1") Set Plan2 = Application.Worksheets("Plan2") 'Define calculation mode With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With 'Use Plan1 With Plan1 'Select this worksheet .Select 'Memory optimization ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView .DisplayPageBreaks = False 'First and last rows' loop FirstRow = .UsedRange.Cells(1).Row LastRow = .UsedRange.End(xlDown).Row 'Loop execution For CurrentRow = LastRow To FirstRow Step -1 'Check Id value in A column With .Cells(CurrentRow, "A") 'Store SoughtId SoughtId = .Value 'Search Address via Id on Plan2 With Plan2 .Select Dim ActiveCell As String With .Range("D:D") 'Search Id If (SoughtId = .Find(SoughtId)) Then EncounteredId = SoughtId End If ActiveCell = .Find(SoughtId).Address End With 'Define/store Address With .Range(ActiveCell) 'Being in current column, go to the column that 'contains the wanted value if this value is not empty If .Offset(0, 9).Value <> "" Then Address = .Offset(0, 9).Value End If End With End With Plan1.Select 'Append Address obtained value in corresponding row's cell 'and increment SuccessCounter With .Offset(0, 15) .Value = Address End With SuccessCounter = SuccessCounter + 1 End With Next CurrentRow End With ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End With EndTime = Time() ElapsedTime = EndTime - StartTime MsgBox "Operation finished!" & vbNewLine & vbNewLine & "Added addresses: " & SuccessCounter & vbNewLine & "Time elapsed: " & ElapsedTime End Sub 

Answer 1

我会尝试不使用.select方法在两个工作表之间来回切换。 而是直接在工作表上引用这些值而不切换。 它看起来像Worksheets("Plan1").Range("Range You Want") 。 也请尽量不要使用ActiveCell因为这会导致excel更改选中数十万次的单元格，这很慢。

希望这可以帮助。

Answer 2

1. 您正在正确使用With ... End With块，但通过添加。select块内的命令来击败它们的目的。
2. 你find一次，看看是否存在，然后再find一个值
3. ActiveCell ， Address等是保留字，不应该重新定义为variables。
4. 声明像Dim Plan1, Plan2 As Worksheet创buildPlan1作为变体而不是工作表types。

看看这是否加快了一个档次。

 Sub Addaddr() Dim Plan1 As Worksheet, Plan2 As Worksheet Dim rw As Long, FirstRow As Long, LastRow As Long Dim CalcMode As Long Dim SoughtId, addr As String Dim SuccessCounter As Long Dim StartTime As Date, EndTime As Date, ElapsedTime As Date StartTime = Time() Set Plan1 = ActiveWorkbook.Worksheets("Plan1") Set Plan2 = ActiveWorkbook.Worksheets("Plan2") 'Define calculation mode With Application .ScreenUpdating = False CalcMode = .Calculation .Calculation = xlCalculationManual .EnableEvents = False End With With Plan1 'First and last rows' loop FirstRow = 1 LastRow = .Cells(Rows.Count, 1).End(xlUp).Row For rw = LastRow To FirstRow Step -1 'Store SoughtId SoughtId = .Cells(rw, "A").Value 'Search addr via Id on Plan2 addr = vbNullString With Plan2 If CBool(Application.CountIf(.Range("D:D"), SoughtId)) Then addr = .Cells(Application.Match(SoughtId, .Range("D:D"), 0), "M").Value End If End With If CBool(Len(addr)) Then .Cells(rw, "O") = addr SuccessCounter = SuccessCounter + 1 End If Next rw End With With Application .EnableEvents = True .Calculation = CalcMode .ScreenUpdating = True End With EndTime = Time() ElapsedTime = EndTime - StartTime MsgBox "Operation finished!" & vbNewLine & vbNewLine & "Added addres: " & SuccessCounter & vbNewLine & "Time elapsed: " & ElapsedTime End Sub 

我使用工作表COUNTIF函数来确定是否存在交叉引用值，然后使用MATCH函数来检索行号。 这不是最有效的，但可能比两个更好。 .Find操作没有错误控制。

如前所述，这将真正受益于基于内存的处理，如字典或变体数组。 看看这里的定时速度testing。

Answer 3

最快的方法仍然是使用具有Excel内置函数的公式。 我把这个公式放到工作表“Plan1”的列O中：

 =IF(ISERROR(MATCH($A1;Plan2!$D:$D;0));"";OFFSET(Plan2!$D$1;MATCH($A1;Plan2!$D:$D;0)-1;9)) 

这是如何工作的：

MATCH($A1;Plan2!$D:$D;0))
如果Plan1！$ A1中的值在Plan2！$ D：$ D范围内find，则返回一个行号，否则返回#NV错误。
如果找不到，则公式将返回一个空string
如果find，则返回相同行号的数值，但返回一个偏移9（“D” – >“M”）的列。

这确实有效。 我testing了长度为600的Plan1和长度为15.0000的Plan2。 重新计算我的电脑大约需要1秒钟。 Jeedped给出的VBA子版大概是同一时间。

当然，重复MATCH()函数会耗费我们的运行时间。 更好的你放
MATCH($A1;Plan2!$D:$D;0)
放入一个未使用的离屏列（比如“X”）并使用
=IF(ISERROR($X1);"";OFFSET(Plan2!$D$1;$X1-1;9))
在目标列中。 （示例公式全部进入第1行）。