VBA实现Excel子项目小计报错Run-time error '1004'求助

问题根源 #

你的代码触发1004错误的核心原因是：循环终止条件依赖“最后一行下方的单引号”，但如果代码没找到这个单引号，会一直向下遍历到Excel最大行（1048576），此时ActiveCell.Offset(1)会指向超出Excel行范围的1048577行，直接触发越界错误。同时依赖ActiveCell的遍历逻辑本身就不稳定，容易出现不可控的单元格跳转。

修复方案 #

改用明确的范围定位+基于数据实际行的终止逻辑，彻底避免越界问题，同时优化代码可读性。以下是修改后的示例代码：

Sub GenerateSubtotals()
    Dim dataWs As Worksheet
    Dim lookupWs As Worksheet
    Dim lastDataRow As Long
    Dim currentRow As Long
    Dim currSubPgm As String
    Dim subtotalVal As Variant
    
    ' 替换为你的数据工作表和查找表所在工作表名称
    Set dataWs = ThisWorkbook.Worksheets("报表数据")
    Set lookupWs = ThisWorkbook.Worksheets("查找表")
    
    ' 获取B列有数据的最后一行（忽略中间空行）
    lastDataRow = dataWs.Cells(dataWs.Rows.Count, "B").End(xlUp).Row
    
    currentRow = 2 ' 假设表头在第1行，数据从第2行开始
    currSubPgm = dataWs.Cells(currentRow, "B").Value
    
    Do While currentRow <= lastDataRow
        ' 定位当前SUB_PGM的最后一行
        Do While currentRow <= lastDataRow And dataWs.Cells(currentRow, "B").Value = currSubPgm
            currentRow = currentRow + 1
        Loop
        
        ' 从Table3查找对应小计值（根据你的实际列数调整VLookup的第3参数）
        subtotalVal = Application.VLookup(currSubPgm, lookupWs.ListObjects("Table3").Range, 2, False)
        
        ' 写入H列小计
        If Not IsError(subtotalVal) Then
            dataWs.Cells(currentRow - 1, "H").Value = subtotalVal
        Else
            dataWs.Cells(currentRow - 1, "H").Value = "小计未找到" ' 可选：处理未匹配的情况
        End If
        
        ' 更新当前SUB_PGM，准备下一轮循环
        If currentRow <= lastDataRow Then
            currSubPgm = dataWs.Cells(currentRow, "B").Value
        End If
    Loop
End Sub

关键修改点 #

1. 取消ActiveCell依赖：用工作表对象dataWs直接操作单元格，避免因单元格跳转导致的不可控问题
2. 明确数据范围：通过End(xlUp)获取B列实际数据的最后一行，从根源上防止遍历到Excel最大行
3. 嵌套循环定位子项目：用内层循环精准定位每个SUB_PGM的起止行，逻辑更清晰
4. 错误处理：加入IsError判断，避免查找不到小计值时触发错误

若需保留单引号终止条件 #

如果必须以“最后一行下方的单引号”作为终止标志，可提前定位该单引号的行号，避免无限循环：

Dim stopRow As Long
On Error Resume Next
' 在B列查找单引号（根据实际位置调整列号）
stopRow = dataWs.Cells(dataWs.Rows.Count, "B").Find(What:="'", LookIn:=xlValues, LookAt:=xlWhole).Row
On Error GoTo 0
' 如果没找到单引号，用数据最后一行+1作为终止
If stopRow = 0 Then stopRow = lastDataRow + 1

之后将循环条件改为currentRow < stopRow即可。

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