Excel VBA не отвечает после запуска макроса с циклом

Question

это мой первый пост после бесконечной попытки в течение 2 недель подряд.

Итак, у меня есть эти мега файлы Excel, содержащие почти 600 000 строк. Я должен вычислить среднее значение определенных значений в моем листе (при определенных условиях), проходя через столбец (второй). Мне нужно l oop моей программы с временем l oop как минимум 630 000 раз. За исключением случаев, когда я запускаю макрос, он автоматически говорит: Excel не отвечает .. и он остается таким в течение нескольких часов. Самый длинный промежуток времени, в течение которого я запускал его, составлял 11 часов, не касаясь ничего ... Я все еще не отвечал ... Забавно то, что, когда я уменьшаю количество циклов только для проверки, это очень быстро, когда я делаю это для 10 000 раз, но он снова блокируется около 35 000.

Вот мой код:

  Dim rw As Long
  Dim erw As Long
  rw = 3
  erw = 631000
  Dim r As Long
  Dim i As Long
  Dim somme As Long
    For r = 1 To 200
      i = 0
      somme = 0
      Do While rw < erw
        If IsNumeric(Cells(rw, 7)) = True Then
          If Cells(rw, 2) = r And Cells(rw, 7) <> 0 Then
            c = Cells(rw, 7).Value
            somme = somme + c
            i = i + 1
        End If
        rw = rw + 1
      End If
    Loop
    If i <> 0 Then
      Cells(r + 2, 8).Value = somme / i
    End If
  Next
End Sub

Я действительно пытался добавить следующее после предложений на этом сайте:

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView

Но он все еще не работал. Если кто-нибудь может помочь мне с этим, я был бы чрезвычайно благодарен. Это мой первый код VBA, и я знаю, что могу сделать это без макроса, но мой начальник настаивает на том, чтобы я делал это таким образом ...

Большое спасибо.

Answer 1

Я нашел решение, которое работало в течение нескольких секунд!

вот новый код, предложенный мне на другом форуме:

Sub AverageMyNumbers()


Dim r, i As Long


r = 3  '' Starting row output data (average result)

i = (r - 1) + 200   '' Last row output data (average result)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range(Cells(r, "H"), Cells(i, "H")).FormulaR1C1 = _

        "=SUMIFS(R3C7:R631000C7,R3C2:R631000C2,ROW(RC8)-ROW(R2C8))/COUNTIFS(R3C7:R631000C7,""<>0"",R3C2:R631000C2,ROW(RC8)-ROW(R2C8))"


Range(Cells(r, "H"), Cells(i, "H")).Value = Range(Cells(r, "H"), Cells(i, "H")).Value

Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Job Done"


End Sub

Еще раз спасибо за ваши комментарии и ответы.

Answer 2

Вот мой код:

Sub SubAverageReport()

    'Declarations.
    Dim RngColumnStages As Range
    Dim RngColumnSpeeds As Range
    Dim RngTarget As Range
    Dim RngResults As Range
    Dim WksWorksheet01 As Worksheet
    Dim BytStage As Byte
    Dim LngCounter01 As Long
    Dim LngDivisor As Long
    Dim LngSpeedsSum As Long

    'Setting variables.
    Set WksWorksheet01 = ActiveSheet
    Set RngColumnStages = WksWorksheet01.Range("B3:B631000")
    Set RngColumnSpeeds = WksWorksheet01.Range("G3:G631000")
    Set RngResults = WksWorksheet01.Range("I3")
    Set RngTarget = RngColumnStages(1, 1)

    'Covering the stages.
    For BytStage = 1 To 200

        'Setting variables.
        LngSpeedsSum = 0
        LngDivisor = 0

        'Covering all the stages recurrence.
        For LngCounter01 = 1 To Excel.WorksheetFunction.CountIf(RngColumnStages, BytStage)
            'Setting the RngTarget as the next recurrence of the given stage.
            Set RngTarget = RngColumnStages.Find(What:=BytStage, _
                                            After:=RngTarget, _
                                            LookIn:=xlValues, _
                                            LookAt:=xlWhole, _
                                            SearchOrder:=xlByRows, _
                                            SearchDirection:=xlNext, _
                                            MatchCase:=False, _
                                            SearchFormat:=False _
                                           )

            'Checking if the speed is numeric and different from 0.
            If IsNumeric(RngColumnSpeeds(RngTarget.Row - RngColumnStages.Row + 1, 1).Value) And _
               (RngColumnSpeeds(RngTarget.Row - RngColumnStages.Row + 1, 1).Value <> 0) Then
                    'Setting LngSpeedsSum so it sums all the numeric value in RngColumnSpeeds different from 0.
                    LngSpeedsSum = LngSpeedsSum + RngColumnSpeeds(RngTarget.Row - RngColumnStages.Row + 1, 1).Value
                    'Setting LngSpeedsSum so it counts all the numeric value in RngColumnSpeeds different from 0.
                    LngDivisor = LngDivisor + 1
            End If
        Next

        'Reporting stage.
        RngResults.Value = BytStage
        'Checking if any record was found and reporting accordingly.
        If LngDivisor <> 0 Then
            RngResults.Offset(0, 1).Value = LngSpeedsSum / LngDivisor
        Else
            RngResults.Offset(0, 1).Value = "No records"
        End If

        'Setting RngResult for the next result.
        Set RngResults = RngResults.Offset(1, 0)
    Next

End Sub

Скажите, удовлетворяет ли он вас, если у вас есть какие-либо вопросы или улучшения, о которых стоит спросить.