加快匹配值处理（如果… = …然后…）

所以我现在有这样的代码：我基本上是要检查，如果一个工作表的列B可以在另一个工作表的列C中find，那么我会在其他工作表的行中findB值， H列值并将其复制到当前工作表的AI列中。 B列中的每一行都将重复此过程。

我遇到的问题是，它的运行速度太慢，即使closuresscreenupdates等。这是有道理的，因为有超过50000值，它必须循​​环与所有值查找。 我真的很感激，如果有人可以看看它，并提出可能的方法，我可以加快这一进程。 谢谢。

Sub Calculation() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Dim i As Long, LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row For i = 5 To LastRow Set wb1 = ThisWorkbook Dim anyRow As Long For anyRow = 4 To 500 If wb1.Sheets("Total").Cells(anyRow, 2).Value = wb1.Sheets("Record").Cells(i, 3).Value Then wb1.Sheets("Record").Cells(i, 35).Value = wb1.Sheets("Total").Cells(anyRow, 8).Value End If Next anyRow Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True End Sub 

Answer 1

这应该做你想要的（快很多）：

 Sub Calculation() With ThisWorkbook Dim i As Long, LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row Dim rngVal(3) As Variant rngVal(0) = .Sheets("Total").Range("B4:B500").Value rngVal(1) = .Sheets("Record").Range("C5:C" & LastRow).Value rngVal(2) = .Sheets("Record").Range("AI5:AI" & LastRow).Value rngVal(3) = .Sheets("Total").Range("H4:H500").Value For i = 1 To LastRow - 4 If IsNumeric(Application.Match(rngVal(1)(i, 1), rngVal(0), 0)) Then rngVal(2)(i, 1) = rngVal(3)(Application.Match(rngVal(1)(i, 1), rngVal(0), 0), 1) Next .Sheets("Record").Range("AI5:AI" & LastRow).Value = rngVal(2) End With End Sub 

Answer 2

使用字典将允许您迭代每个工作表一次。 一个字典将信息存储在{Key，Value}对中。 密钥是唯一的，并用作查找关联的值。

在这里，我们从表格（“总计”）向字典中添加{Key，Value}对

 k = .Cells(i, 2).Text v = .Cells(i, 2) If Not dictTotals.Exists(k) Then dictTotals.Exists.Add k, v 

现在当我们迭代Sheets（“Record”）时，我们检查是否有匹配。 如果是这样，我们将键的值分配给.Cells（i，35）.Value。

 k = .Cells(i, 3).Text If dictTotals.Exists(k) Then .Cells(i, 35).Value = dictTotals(k) 

我推断这个方法来处理切换事件。 这样，我们就可以把重点放在Calculation（）方法的主要任务上。

 Sub Calculation() EnableAllEvents True Dim i As Long, LastRow As Long Dim dictTotals Dim k As String, v As Variant Set dictTotals = CreateObject("Scripting.Dictionary") LastRow = Range("A" & Rows.Count).End(xlUp).Row With Sheets("Total") For i = 5 To LastRow k = .Cells(i, 2).Text v = .Cells(i, 2) If Not dictTotals.Exists(k) Then dictTotals.Exists.Add k, v Next End With With Sheets("Record") LastRow = Range("c" & Rows.Count).End(xlUp).Row For i = 4 To LastRow k = .Cells(i, 3).Text If dictTotals.Exists(k) Then .Cells(i, 35).Value = dictTotals(k) Next End With EnableAllEvents False End Sub Sub EnableAllEvents(bEnableEvents As Boolean) With Application If bEnableEvents Then .Calculation = xlCalculationAutomatic Else .Calculation = xlCalculationManual .ScreenUpdating = bEnableEvents .DisplayStatusBar = bEnableEvents .EnableEvents = bEnableEvents .DisplayPageBreaks = bEnableEvents End With End Sub