Петля VBA падает после 40 или 60 петель - PullRequest
0 голосов
/ 03 декабря 2018

Я выгуливал глаза, и я очень новичок.

Я использую макрос, чтобы просмотреть список идентификаторов клиентов, отфильтровать сводку с идентификатором, экспортироватьЛист в формате PDF, а затем повторите цикл.

Мне, наконец, через несколько дней удалось запустить его в течение 60 раз, но потом он перезапускает Excel.Я только что увеличил файл подкачки с 2 ГБ до 16 ГБ.

Я использую цикл do while, и я пытаюсь установить объекты = ничего, чтобы очистить ресурсы, и я сохраняю файл в одной точке, а также я использую DoEvents, установите для screenupdate значение false, установите для Microsoft XPS значениепринтер по умолчанию, выводит на печать значение false, все диапазоны хранятся в переменных вместо выбранных, рабочие листы также сохраняются в переменных вместо активации.Я пробовал проходить, используя точки останова и т. Д. И видеть, как он работает 60 раз без ошибок.

Я предполагаю, что, поскольку он увеличился с 40 до 60 до сбоя, это может быть связано с ресурсамисо временем раздувается.

Мой код, будучи новичком, может потребоваться очистить, так как он должен работать около 1000 раз без сбоев.Это смесь различных поисков в Google о том, как делать разные вещи.

            Option Explicit
Public Global_Sti As String
Public Global_MD As String
Public Month As String
Public FirstKardex As Variant
Public Global_EnkeltSti As String
Dim restart As String

Sub exporterkardexfiler()
start:

restart = "yes"

Do While restart = "yes"
Call kørsel
Loop


End Sub

Sub kørsel()

Application.ScreenUpdating = False
Dim næsteRapportAntal As Integer
Dim næsterækketæller As Integer
Dim sh As Worksheet
Dim k As Long 'bruges til at tælle antal rækker der er kardex værdier i
Dim i As Integer 'bruges til løkken, skal køre så længe antallet af kørsler er mindre eller lig med i
Dim n As Integer 'antal handlinger inde i løkken, bruges som tæller op imod i
Dim row As Integer 'bruges til at tælle rækker
Dim kardexkol As Excel.Range
Dim temp As String
Dim tid As Date


Set sh = Worksheets("Pivoter")
Set kardexkol = sh.Range("A5") 'kolonne der skal findes kardex i
k = sh.Range("A2000").End(xlUp).row 'tæl antallet af celler med værdi i kolonne A

Call Stopwatch.WorkstAtMidnight(1) ' kald stopur modul med 1 for aktivering
i = k - 4 'antal rapporter der skal genereres
row = 1 + Range("lastrun").Value 'tæller til at skifte til næste række.
n = 1 + Range("AddFirstCount")

næsteRapportAntal = Worksheets("Rapport").Range("x10").Value 'tæller til at styre hvornår antal er ligmed i. Juster til højere tal for at begrænse rapport antal.
næsterækketæller = 1 'tæller til at styre hvilket nr næste række, der skal bruges data fra, har.


'opret en ny mappe med sidste måneds navn + år, baseret på filsti oplyst i ark"Filer":A6
Global_Sti = Range("pFiloutput1") & "\"
Call nymappe.lavmappe(Global_Sti)
Global_MD = Global_MD & "\"

Dim whs As Worksheet
Set whs = Worksheets("Rapport")

Dim printrng As Excel.Range
Set printrng = whs.Range("udskrift")

Dim GemtFil As String


Dim liste As Excel.Range
Set liste = sh.Range("A4:A1100")




On Error GoTo skip

With liste

Do While n <= i
Dim kardex As Variant
temp = "start do while"


kardex = kardexkol.Rows(row).Value
If kardex = "Hovedtotal" Then GoTo færdig
If n = 1 Then FirstKardex = kardex


     'filtrer kardex pivot med kardex nr fundet med sub function fra modul filtrerekardexpivot
     temp = "filtrer pivot1"

     Call FiltrerKardexpivot.FiltrerKardexpivot(kardex)
     temp = "filtrer pivot1 done"

        tid = Now()
     '   Worksheets("error").Range("tid").Value = tid & " filtrer pivot save "


     'opdater skærm, genberegn formler så farver matcher indeks-match opslag.
     Worksheets("Billeder").Calculate
     Application.Wait (Now + TimeValue("0:00:11")) 'pause så farvekoder passer

     Application.DisplayAlerts = False

    temp = "gem pdf"

    Dim pdfnavn As String
    pdfnavn = Global_MD & kardex & " - " & Month

    On Error GoTo skip
    Call exportPDF.exportPDF(printrng, pdfnavn)
    On Error GoTo 0
     temp = "gem pdf done"

     'GemtFil = Global_MD & kardex & " - " & Month & ".pdf"
     'Call SendEmail.SendEmail(email, "Månedsrapport affald - " & Month, GemtFil)
     temp = "email"

     'Set email = Nothing
     'GemtFil = ""
     Set kardex = Nothing
     pdfnavn = ""
     ActiveWorkbook.Save

     Application.DisplayAlerts = True

        Worksheets("Rapport").Range("lastrun") = row

        n = n + næsteRapportAntal
        row = row + næsterækketæller

        If n = 60 Then GoTo restart


        Loop
End With

On Error GoTo 0

færdig:

Call FiltrerKardexpivot.FiltrerKardexpivot(FirstKardex)
Call FiltrerKardexpivot.FiltrerKardex12(FirstKardex)
Worksheets("Rapport").Activate
Range("lastrun") = 0
Call Stopwatch.WorkstAtMidnight(0)
ActiveWorkbook.Save
restart = "no"
MsgBox ("Rapport Generator er nu Færdig!")



Exit Sub

skip:
Dim errortxt As String
MsgBox "Fejl!" & Err.Description & " kardex: " & kardex
tid = Now()
Worksheets("error").Range("tid").Value = tid & " Error save "
Worksheets("error").Range("temp").Value = temp
errortxt = "err num: " & Err.Number & "Err.Descrip: " & Err.Description & "Err.Source: " & Err.Source
Worksheets("error").Range("error").Value = errortxt
restart = "no"
ActiveWorkbook.Save

Exit Sub

On Error GoTo 0

restart:
MsgBox "restarting at nr " & n
restart = "yes"
Exit Sub

End Sub

1 Ответ

0 голосов
/ 03 декабря 2018

Теперь я выполняю цикл 246 раз на 64-битной и 175 раз на 32-битной.Оба начинают создавать пустые файлы PDF, а затем вылетает.Но цикл удаляется гораздо дольше после удаления этих изображений.Поэтому я думаю, что это было решением, и теперь мне нужно выяснить, как предотвратить испорченные и пустые PDF-файлы и / или обнаружить их и уничтожить макрос.

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

...