Question

所以我目前的代码看起来像这样：我基本上试图检查是否可以在另一张表的C列中找到一张表B的列，然后我会在在我找到B值的其他工作表行中，取其H列值并将其复制到当前工作表的AI列。将对B列中的每一行重复此过程。

我遇到的问题是它的运行方式太慢，即使关闭了屏幕更新等等。这是有道理的，因为有超过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

使用字典将允许您只迭代每张表一次。字典以{Key，Value}对存储信息。密钥是唯一的，用于查找关联的值。

我们在这里添加来自Sheets（＆＃34; Total＆＃34;）的{Key，Value}对到词典

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

现在我们迭代表格（＆＃34;记录＆＃34;），我们检查是否有匹配。如果是这样，我们将Key的值分配给.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

Answer 2

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

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

加速匹配值处理（如果...... = ......那么......）

2 个答案: