excel - 每个循环通过工作簿中的工作表多次的单个 VBA

Question

我在一个 Excel 工作簿中有一个 VBA 脚本，它遍历大量工作表(大约 100 个)以将数据合并到一个工作表中。这也是从 PDF 文件导出的数据。我试图清理所有不可打印的字符和格式，但我不确定我是否遗漏了一些。
它使用单个 For Each ws In Workbook循环，但在执行时，脚本会在工作簿中循环看似随机的次数，并在看似随机的工作表处停止。这会导致问题，因为有时在执行时，摘要变为 10K 行而不是 1K。
有谁知道为什么会这样？
由于数据是从 PDF 导入的，因此没有以有用的方式格式化。我有其他脚本可以让我达到可以合并和使用电源查询的地步。每个工作表的布局是:

|------|---------------|---------|--------------|----------|
| Buy  |  Description  |  Symbol |   Price ($)  |  null    |
| null |  Lrg Co       |  VOO    |   $242.55    | 1/2/2018 |
| cont....

还有 VBA 代码(不是最漂亮的，但可以完成工作......几乎):

Sub summarize()
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim i As Integer
    Dim stcol As Integer
    Dim endcol As Integer
    Dim strow As Integer
    Dim endrow As Integer
    Dim symrng As Range
    Dim totrow As Integer
    Dim j As Integer
    Dim itm As Range
    Dim lr As Long
    
    j = 1
    
    For Each ws In Worksheets
        stcol = 1       
        Set symrng = ws.Cells.Find("Symbol", LookAt:=xlPart, MatchCase:=False)      
        strow = symrng.Row      
        endcol = symrng.Offset(1, 0).End(xlToRight).Column     
        endrow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        Set symrng = Nothing
        totrow = endrow - strow
        
        For i = 0 To totrow
            Worksheets("Summary").Range(Worksheets("Summary").Cells(j + 1, 1), Worksheets("Summary").Cells(j + 1, endcol)).Value = itm.Value
            j = j + 1
        Next i
    Next ws
    
    Application.ScreenUpdating = True

End Sub

Answer 1

谢谢@FoxFireBurnsandBurns 的想法，我只用几张纸运行了脚本。我没有测试 Summary所以它不断迭代导入的数据，直到我猜测 excel 触发了内存断路器。添加此行修复它:If ws.Name = "Summmary" Then GoTo Nextws:完整的代码是:

Sub summarize()
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim i As Integer
    Dim stcol As Integer
    Dim endcol As Integer
    Dim strow As Integer
    Dim endrow As Integer
    Dim symrng As Range
    Dim totrow As Integer
    Dim j As Integer
    Dim itm As Range
    Dim lr As Long
    
    j = 1
    
    For Each ws In Worksheets
        ' Exclude Summary Sheet
        If ws.Name = "Summmary" Then GoTo Nextws:

        stcol = 1       
        Set symrng = ws.Cells.Find("Symbol", LookAt:=xlPart, MatchCase:=False)      
        strow = symrng.Row      
        endcol = symrng.Offset(1, 0).End(xlToRight).Column     
        endrow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        Set symrng = Nothing
        totrow = endrow - strow
        
        For i = 0 To totrow
            Worksheets("Summary").Range(Worksheets("Summary").Cells(j + 1, 1), Worksheets("Summary").Cells(j + 1, endcol)).Value = itm.Value
            j = j + 1
        Next i
Nextws:
    Next ws
    
    Application.ScreenUpdating = True

End Sub