Цикл занимает слишком много времени для выполнения кода

#excel #vba

#excel #vba

Вопрос:

В файле Excel у меня 600000 строк, а приведенный ниже код требует слишком много времени для выполнения. Он получает 150 строк за 1 минуту. Есть предложения по улучшению приведенного ниже кода?

 For i = 2 To UBound(vArray, 1)
    With Worksheets(1).Range("C2:C" amp; 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. Того, что вы предоставили, недостаточно, чтобы мы могли ответить. Нам понадобится код внутри цикла. Но, сказав это, этот вопрос лучше подходит для codereview.stackexchange.com Но прежде чем публиковать там, убедитесь, что вы прочитали, что ожидается от хорошего вопроса. Они хотят намного больше информации.

2. Z получает 600000 строк в varray, у меня 104000

3. Насколько большим становится UBound(vArray, 1) ?

4. Я получаю 104000 строк в varray

5. Кто-нибудь может мне помочь?

Ответ №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 " amp; findIndex
      End If
    Next rowNum
  Next findIndex

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