循环需要太多时间来执行代码

时间:2019-03-22 21:11:55

标签: excel vba

在Excel文件中,我有600000行,而下面的代码要花太多时间才能执行。 1分钟内获得150行。有什么建议可以改善以下代码吗?

For i = 2 To UBound(vArray, 1)
    With Worksheets(1).Range("C2:C" & Z)
        Set c = .Find(Sheet2.Cells(i, "A"), LookIn:=xlValues)
        If Not c Is Nothing Then
            firstaddress = c.Address
            Do
              If Sheet2.Cells(i, "A") = Sheet.Cells(c.Row, 3) Then
                 If UCase(Sheet1.Cells(c.Row, "D")) = "AVDELING" Then
                    Sheet2.Cells(i, 2) = Sheet1.Cells(c.Row, 5)
                 ElseIf UCase(Sheet1.Cells(c.Row, "D")) = "PROSJEKT" Then
                    Sheet2.Cells(i, 3) = Sheet1.Cells(c.Row, 5)
                 End If
             End If
                Set c = .FindNext(c)
                If firstaddress = c.Address Then
                    GoTo end_this
                End If
            Loop While Not c Is Nothing
        End If
    End With
end_this:
Next i

1 个答案:

答案 0 :(得分:1)

尝试使用内存数组而不是Excel范围来搜索和存储结果。下面的代码将在几秒钟内执行。

Sub Test()
  Dim findWhat() As Variant
  Dim findIn() As Variant
  Dim rowNum As Long
  Dim findIndex As Long
  Dim results() As Variant

  findWhat = Array("A10", "B5", "C3")
  findIn = Range("A1:A640000").Value
  results = Range("B1:D640000").Value

  For findIndex = LBound(findWhat) To UBound(findWhat)
    For rowNum = LBound(findIn) To UBound(findIn)
      If findWhat(findIndex) = findIn(rowNum, 1) Then
        results(rowNum, 1) = "Found " & findIndex
      End If
    Next rowNum
  Next findIndex

  Range("B1:D640000").Value = results
End Sub