Макрос VBA постепенно замедляется в цикле - PullRequest
0 голосов
/ 19 марта 2020

Привет, у меня есть проблема. Я написал инструмент проверки, который проверяет каждую ячейку на листе, если она действительна. Время проверки достоверности около 500 тыс. Ячеек удовлетворительное. Макрос работает даже. Но мне нужно (я так себе представлял) сообщить, что не так с каждой клеткой. Поэтому я использую комментарии, чтобы пользователи могли читать, что не так с каждой ячейкой. Проблема в том, что после 1000 строк (100 тыс. Комментариев) макрос резко замедляется .

Может кто-нибудь объяснить, что происходит за кодом (внутри "с помощью wsTestSample")? Или где я могу найти любую документацию, которая объясняет весь Excel бэкэнд, и как он обрабатывается. Что я уже нашел в сети, этот файл набирает вес при добавлении комментариев. Тем не менее, я не уверен, так ли это.

Я использую Application.ScreenUpdating = False et c. в другом разделе кода.

Public Function validationProcesscellOB()

Dim bFailed As Boolean
Dim iFirstDataRow As Integer
Dim cellOb As Object
Dim counter As Integer
Dim lastRow As Long
Dim lColumnCollection, i, j As Long
Dim retCom As String



Application.ScreenUpdating = False

If IsNumeric(UserForm1.TextBox2.Value) = True Then
    If UserForm1.CheckBox3.Value = True Then
        iFirstDataRow = CInt(UserForm1.TextBox2.Value)
    Else
        iFirstDataRow = 6
    End If
Else
    iFirstDataRow = 6
End If
lastRow = wsTestSample.Cells(wsTestSample.Rows.Count, 2).End(xlUp).Row

For i = iFirstDataRow To lastRow
    DoEvents
    setProgress i / lastRow
    Debug.Print CStr(i) & " .."
    bFailed = False
    counter = 0
    For j = 1 To collHeadderIndexes.Count
        lColumnCollection = CLng(Split(collHeadderIndexes.item(j), "#")(1))
        'Set cellOb = wsTestSample.Cells(i, CLng(Split(collHeadderIndexes.Item(j), "#")(1)))
        retCom = validCollection(Split(collHeadderIndexes.item(j), "#")(0)).validateField(CStr(dataArray(lColumnCollection, i)))
        If Len(retCom) > 0 Then
            With wsTestSample.Cells(i, lColumnCollection)
                .Interior.Color = RGB(255, 0, 0)
                .ClearComments
                .AddComment retCom
                .Comment.Visible = False
                '.Comment.Shape.TextFrame.AutoSize = False
            End With
            bFailed = True
            counter = counter + 1
        End If

    Next j
    If bFailed = True Then
        wsTestSample.Cells(i, emptyColIndex).Value = "Data Not Valid"
        wsTestSample.Cells(i, emptyColIndex + 1).Value = counter
    Else
        wsTestSample.Cells(i, emptyColIndex).Value = "Ok"
    End If
Next i
Application.ScreenUpdating = True

Функция завершения

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...