Страницы: 1
RSS
Ускорить работу макроса
 
Добрый день!
Есть небольшой макрос, который считает рабочее время. Суть в том, что там очень много раз проходит он по циклу и из-за этого скорость обработки данных низкая. (в файле 1000 строк обрабатывает в течение 1.5 минут, ожидается что в файле будет около 20000 строк и время обработки должно быть более менее адекватным). Я так подозреваю, что это можно вообще решить без циклов, но к сожалению не могу сообразить как. Если кто возьмется помочь, то я могу более подробно рассказать по задаче макроса и тому как сейчас работает. Код прилагаю тут ,файл вышлю исполнителю.

По бюджету 1000 р.
Код
Sub Рассчет()

a = Timer
Application.ScreenUpdating = False

Range(Cells(2, 18), Cells(1048576, 19)).ClearContents

n = Cells(Rows.Count, 7).End(xlUp).Row
n3 = Лист3.Cells(Rows.Count, 4).End(xlUp).Row

Начало_дня = Лист3.Cells(2, 2)
Конец_дня = Лист3.Cells(3, 2)
Начало_обеда = Лист3.Cells(4, 2)
Конец_обеда = Лист3.Cells(5, 2)

Праздники = Range(Лист3.Cells(1, 4), Лист3.Cells(n3, 4))

Массив = Range(Cells(1, 1), Cells(n, 9))



For i = 2 To n
    If Массив(i, 9) = "Выполнен" Then
        Cells(i, 18) = Массив(i, 7)
    Else
        Дата = Массив(i, 7)
        For i2 = 1 To 1440
            Дата = Дата - (1 / 1440)
            If DatePart("w", Дата) = 7 Or DatePart("w", Дата) = 1 Then
                i2 = i2 - 1
                GoTo metka
            End If
            For i3 = 2 To n3
                If DateSerial(Year(Дата), Month(Дата), Day(Дата)) = Праздники(i3, 1) Then
                    i2 = i2 - 1
                    GoTo metka
                End If
            Next i3
            If TimeSerial(Hour(Дата), Minute(Дата), Second(Дата)) > Конец_дня Or TimeSerial(Hour(Дата), Minute(Дата), Second(Дата)) < Начало_дня Or (TimeSerial(Hour(Дата), Minute(Дата), Second(Дата)) >= Начало_обеда And TimeSerial(Hour(Дата), Minute(Дата), Second(Дата)) <= Конец_обеда) Then
                i2 = i2 - 1
                GoTo metka
            End If
            
metka:
        Next i2
        Cells(i, 18) = Дата
    End If
    

    If Массив(i, 8) >= Cells(i, 18) Then Cells(i, 19) = Int(DateDiff("n", Cells(i, 18), Массив(i, 8)) / 60) & ":" & Int((DateDiff("n", Cells(i, 18), Массив(i, 8)) / 60 - Int(DateDiff("n", Cells(i, 18), Массив(i, 8)) / 60)) * 60)
Next i
Application.ScreenUpdating = True
MsgBox Timer - a
MsgBox "Готово"

End Sub



 
Давайте побеседуем

Готово, обменялись
Страницы: 1
Наверх