Question

为什么Excel不能循环遍历大型数据集？！

我有2个不同的文档表单需要导出为数百个PDF。我从互联网上提取批量导出脚本并根据我的使用情况对其进行修改，以便根据＆＃34;批量PDF打印机＆＃34;中选择的复选框处理这些表单中的任何一个。工作表。

一切运行良好 - 循环访问的前10-15个工作簿，然后崩溃。每个Excel文档冻结（无响应），宏当前访问的页面部分打开，没有可见的数据或单元格。＆＃34;出版＆＃34;消息框也可能在此时冻结。一旦它报告缺少内存错误 - 但我无法重复这一点。 Excel不应该删除未使用的缓存，以免内存过载吗？如果它运行不好一段时间，我会怀疑是一个流浪汉循环。我听说没有办法在＆＃34;缓存转储中编写脚本＆＃34;或者那种性质的东西。这是不好的代码，还是我对处理器的要求太高了？

Sub Convert2PDF()
'Update the checkbox linked formulas on the GUI workbook
Sheet1.Range("A2").Formula = Sheet1.Range("A2").Formula
Sheet1.Range("B2").Formula = Sheet1.Range("B2").Formula
Sheet1.Range("C2").Formula = Sheet1.Range("C2").Formula

Dim strFolder As String
Dim strXLFile As String
Dim strPDFFile As String
Dim wbk As Workbook
Dim lngPos As Long
' set folder
strFolder = ThisWorkbook.Path & "\putfileshere" & "\"
Application.ScreenUpdating = False
' Get first filename
strXLFile = Dir(strFolder & "*.xls*")
' Loop through Excel workbooks in folder
Do While strXLFile <> ""
    ' Open workbook
    Set wbk = Workbooks.Open(Filename:=strFolder & strXLFile)
    ' Assemble the PDF filename
    lngPos = InStrRev(strXLFile, ".")
    strPDFFile = Left(strXLFile, lngPos) & "pdf"
    ' Export to PDF
    'Do the next 8 lines crash the Macro because they recalculate for every sheet? Page1, Page2, Page3 value are the same for all workbooks processed in a batch
            Dim Page1 As String
            Dim Page2 As String
            Dim Page3 As String
            Dim Page4 As String
                Page1 = ThisWorkbook.Sheets("Batch PDF Printer").Range("A2")
                Page2 = ThisWorkbook.Sheets("Batch PDF Printer").Range("B2")
                Page3 = ThisWorkbook.Sheets("Batch PDF Printer").Range("C2")

            If ThisWorkbook.Sheets("Batch PDF Printer").Range("C2") = "" Then 
                wbk.Sheets(Array(Page1, Page2)).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\pdfsgohere" & "\" & wbk.Name, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False

'run process for format option 2
            Else:
                wbk.Sheets(Array(Page1, Page2, Page3)).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\pdfsgohere" & "\" & wbk.Name, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False
            'Tried killing the finished document to improve function
                Dim xFullName As String
                xFullName = Application.ActiveWorkbook.FullName
                ActiveWorkbook.Saved = True
                Application.ActiveWorkbook.ChangeFileAccess xlReadOnly
                Kill xFullName
                Application.ActiveWorkbook.Close False

            End If
    ' Close workbook - didn't seem to help (can't do it when the workbook is gone)
       'wbk.Close SaveChanges:=False

    ' Get next filename
    strXLFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "All Done"

感谢您的帮助。我已经试图解决这个问题好几天了。

Answer 1

我在> 30个文件上运行，没有问题：

Sub Convert2PDF()

    Dim strFolder As String, strXLFile As String
    Dim strPDFFile As String
    Dim wbk As Workbook
    Dim lngPos As Long
    Dim pages(1 To 4) As String
    Dim shtBatch As Worksheet, arr

    Set shtBatch = ThisWorkbook.Sheets("Batch PDF Printer")
    shtBatch.Range("A2:C2").Calculate '<< assume this was the point of resetting the formulas?
    pages(1) = shtBatch.Range("A2").Value
    pages(2) = shtBatch.Range("B2").Value
    pages(3) = shtBatch.Range("C2").Value

    'what pages to print?  Only need to do this once
    arr = IIf(Len(pages(3)) = 0, Array(pages(1), pages(2)), _
                                 Array(pages(1), pages(2), pages(3)))

    strFolder = ThisWorkbook.Path & "\putfileshere\"
    strXLFile = Dir(strFolder & "*.xls*")

    Do While strXLFile <> ""

        Set wbk = Workbooks.Open(Filename:=strFolder & strXLFile, ReadOnly:=True)

        lngPos = InStrRev(strXLFile, ".")
        strPDFFile = Left(strXLFile, lngPos) & "pdf"

        wbk.Sheets(arr).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & "\pdfsgohere\" & strPDFFile, _
            Quality:=xlQualityStandard, IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False

        wbk.Close False

        strXLFile = Dir
    Loop

    MsgBox "All Done"

End Sub

Answer 2

即使您的可见系统RAM没有超载，Excel应用程序的内部容量似乎也会短暂超过。在应用程序进入自动重启之前，我终于能够查看消息框“没有足够的系统资源可以完全显示”。尝试简化循环访问的工作簿。如果您的工作簿需要一段时间才能启动，这可能表明背景过程繁重（计算和VBA潜艇）。 DoEvents可以通过要求更多的处理时间来帮助代码更顺畅地运行，以便系统可以对其需求进行排序。最终，

Application.Calculation = xlManual

循环顶部的

足以减少20 gig系统的计算需求（我从未预料到会超载）。

Answer 3

如果您在导出文件中链接了图像。

导出的链接图像在内核中留下了一个位或一个字节，这会累积并最终破坏excel。

我在Internet上仅找到此解决方案的一个地方，却再也找不到了，但是通过删除链接的图像，它使我从200s循环到1000个VBA宏循环。

VBA代码没有任何帮助，我使用了暂停，保存工作簿以清除内存，禁用事件等...

我在这里为我的问题写了一个答案：https://stackoverflow.com/a/53600884/10069870

忽略出口中是否没有链接的图像：）

循环播放＆＃34;批量导出＆＃34;崩溃 - 处理器或代码错误？

3 个答案: