Вложенные циклы, вызывающие сбой Excel - PullRequest
Новая
       11

Вложенные циклы, вызывающие сбой Excel

0 голосов
/ 04 сентября 2018

Я пытаюсь запустить макрос VBA, который перебирает около 67 000 строк по 100 столбцов в каждой строке. Для каждой из ячеек в этих строках значение сравнивается со столбцом с 87 записями на другом листе. При запуске кода ошибок не замечено, но Excel каждый раз вылетает. Странно то, что код работает; У меня установлено, чтобы отметить каждую строку, в которой найдено совпадение, и это происходит до сбоя. Я пытался запустить его много раз, и он пробежал от 800 до 11 000 строк перед сбоем, в зависимости от попытки.

Моим первым подозрением было переполнение памяти из-за объема вычислений, но моя система показывает загрузку ЦП на 100% и использование памяти около 50% при выполнении этого кода: 

Sub Verify()

    Dim codes As String
    Dim field As Object

    For i = 2 To Sheets("DSaudit").Rows.Count
        For Each field In Sheets("Dsaudit").Range(Cells(i, 12), Cells(i, 111))
            r = 1
            While r <= 87
                codes = ThisWorkbook.Sheets("287 Denominator CPT").Cells(r, 1).Value
                If field = codes Then
                    Cells(i, 112).Value = "True"
                r = 88
                Else
                    r = r + 1
                End If
            Wend
        Next field
        i = i + 1
    Next i
End Sub

Следует также отметить, что я все еще очень плохо знаком с VBA, поэтому, скорее всего, я совершил какую-то вопиющую ошибку новичка. Могу ли я внести некоторые изменения в этот код, чтобы избежать сбоя, или я должен отменить его и применить более эффективный подход?

1 Ответ

0 голосов
/ 04 сентября 2018

По возможности итерируйте вариантные массивы. Это ограничивает количество раз, которое vba требуется для доступа к рабочему листу.

Каждый раз, когда завеса между vba и Excel пробивается, стоит времени. Это только пробивает эту завесу 3 раза, а не 9,031,385,088 

Sub Verify()


    With Sheets("DSaudit")

        'Get last row of Data
        Dim lastrow As Long
        lastrow = .Cells(.Rows.Count, 12).End(xlUp).Row 'if column 12 ends before the last row of data change to column that has them all.

        'Load Array with input Values
        Dim rng As Variant
        rng = .Range(.Cells(2, 12), .Cells(lastrow, 111)).Value

        'Create output array
        Dim outpt As Variant
        ReDim outpt(1 To UBound(rng, 1), 1 To 1)

        'Create Match array
        Dim mtch As Variant
        mtch = Worksheets("287 Denominator CPT").Range("A1:A87").Value

        'Loop through first dimension(Row)
        Dim i As Long
        For i = LBound(rng, 1) To UBound(rng, 1)
            'Loop second dimension(Column)
            Dim j As Long
            For j = LBound(rng, 2) To UBound(rng, 2)
                'Loop Match array
                Dim k As Long
                For k = LBound(mtch, 1) To UBound(mtch, 1)
                    'If eqaul set value in output and exit the inner loop
                    If mtch(k, 1) = rng(i, j) Then
                        outpt(i, 1) = "True"
                        Exit For
                    End If
                Next k
                'If filled true then exit this for
                If outpt(i, 1) = "True" Then Exit For
            Next j
        Next i

        'Assign the values to the cells.
        .Cells(2, 112).Resize(UBound(outpt, 1), 1).Value = outpt
    End With

 End Sub
...