Excel VBA遍历单列22行出现Out of Memory内存错误问题咨询

核心错误点 #

• 逻辑判断语法错误：If Cells.Value = "Estimated GP%:" Or "Estimated GP%: " 写法不符合VBA语法，Or两侧都需要写完整的判断表达式，错误写法会导致判断恒为真，持续触发无效赋值占用内存
• 遍历区域绑定错误：rng = Range("B1:B22") 在循环外定义，只会绑定代码运行时当前激活工作表的B列区域，后续遍历其他工作表时rng不会动态切换，遍历逻辑完全错位
• 无效操作过多：每次遍历单元格都来回切换工作表，触发数千次窗口重绘，是内存溢出的直接诱因
• 变量与取值不匹配：判断用无明确指向的Cells，取值用ActiveCell，和当前遍历的Cell对象完全不对应，逻辑完全错误
• 变量声明不规范：rng、Cell未声明类型，EstimGP用Integer类型存储百分比/小数时容易溢出

修正后代码 #

Sub EstimGP()
    ' 强制变量声明，避免隐式声明错误
    Dim ws As Worksheet
    Dim sumWs As Worksheet
    Dim searchRng As Range
    Dim cell As Range
    Dim EstimGP As Double ' 用Double存储小数/百分比避免溢出
    Dim i As Integer
    
    ' 提前绑定汇总表，避免循环中反复调用
    Set sumWs = ThisWorkbook.Worksheets("SummaryData")
    i = 1
    
    ' 遍历所有工作表，排除汇总表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> sumWs.Name Then
            EstimGP = 0 ' 每次遍历新表先重置数值
            ' 绑定当前表的B1:B22区域
            Set searchRng = ws.Range("B1:B22")
            For Each cell In searchRng
                ' 修正逻辑判断，Trim去掉前后空格避免多匹配
                If Trim(cell.Value) = "Estimated GP%:" Then
                    EstimGP = cell.Offset(0, 1).Value
                    Exit For ' 找到后直接退出循环，减少无效遍历
                End If
            Next cell
            ' 直接给汇总表赋值，不需要激活切换
            sumWs.Cells(i, 10).Value = EstimGP
            i = i + 1
        End If
    Next ws
End Sub

优化说明 #

• 全程不用Activate/Select操作，避免窗口重绘消耗内存
• 提前绑定汇总表对象，减少重复对象调用开销
• 用Trim处理匹配字符串，不需要写两个匹配条件
• 找到目标值后直接退出当前表的单元格循环，减少无效遍历
• 所有变量明确声明类型，避免隐式声明导致的未知错误

内容的提问来源于stack exchange，提问作者John Doe