Excel运行时错误1004（应用程序定义或对象定义错误）求助

常见问题点及修复方案 #

1. 摒弃Select/Selection操作，直接操作单元格对象 #

原代码依赖Select和Selection，这种写法极易因选中状态变化触发错误，且运行效率低。直接通过单元格引用操作更稳定：

原代码片段：

ActiveCell.Offset(-14, -4).Range("A1:F11").Select
Selection.ClearContents

修改为：

ActiveCell.Offset(-14, -4).Resize(11, 6).ClearContents

用Resize(行数,列数)代替嵌套Range("A1:F11")，避免区域引用歧义。

2. 检查偏移后是否超出工作表边界 #

如果ActiveCell的行号小于15，或列号小于5，执行Offset(-14, -4)会得到行/列号为0或负数的无效单元格，直接触发1004错误。必须先做合法性判断：

Dim targetRange As Range
Set targetRange = ActiveCell.Offset(-14, -4)
If targetRange.Row >= 1 And targetRange.Column >= 1 Then
    targetRange.Resize(11, 6).ClearContents
Else
    MsgBox "当前单元格偏移后超出工作表范围，请调整选中位置"
    Exit Sub
End If

3. 修正AdvancedFilter的参数范围问题 #

原代码中AdvancedFilter的源数据、条件区域、复制目标区域都可能存在偏移越界，或区域引用逻辑模糊的问题，需调整并增加合法性检查：

• 源数据区域必须包含表头，且表头需与条件区域、复制目标区域的表头完全匹配
• 复制目标区域ActiveCell作为起始单元格，需确保其所在列是目标表头的起始位置

修正后的AdvancedFilter代码：

Dim sourceRange As Range
Dim criteriaRange As Range
Dim copyToRange As Range

Set sourceRange = ActiveCell.Offset(3, -7)
Set criteriaRange = ActiveCell.Offset(0, -7)
Set copyToRange = ActiveCell

' 检查所有区域是否合法
If sourceRange.Row >= 1 And sourceRange.Column >= 1 And _
   criteriaRange.Row >= 1 And criteriaRange.Column >= 1 And _
   copyToRange.Row >= 1 And copyToRange.Column >= 1 Then
    sourceRange.Resize(11, 6).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=criteriaRange.Resize(2, 6), _
        CopyToRange:=copyToRange, Unique:=False
Else
    MsgBox "筛选参数区域超出工作表范围，请调整选中位置"
    Exit Sub
End If

4. 明确指定工作表对象（多表场景） #

如果代码涉及多个工作表，需明确指定操作的工作表，避免因ActiveSheet切换导致的错误：

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为你的工作表名

ws.Activate
ws.ActiveCell.Offset(-14, -4).Resize(11, 6).ClearContents

完整修正代码 #

Sub FixAdvancedFilter()
    Dim ws As Worksheet
    Dim targetRange As Range
    Dim sourceRange As Range
    Dim criteriaRange As Range
    Dim copyToRange As Range
    
    Set ws = ActiveSheet
    ' 检查是否选中了单元格
    If TypeName(Selection) <> "Range" Then
        MsgBox "请先选中一个单元格"
        Exit Sub
    End If
    
    ' 处理清除内容逻辑
    Set targetRange = ws.ActiveCell.Offset(-14, -4)
    If targetRange.Row >= 1 And targetRange.Column >= 1 Then
        targetRange.Resize(11, 6).ClearContents
    Else
        MsgBox "清除内容的目标区域超出工作表范围，请调整选中位置"
        Exit Sub
    End If
    
    ' 处理高级筛选逻辑
    Set sourceRange = ws.ActiveCell.Offset(3, -7)
    Set criteriaRange = ws.ActiveCell.Offset(0, -7)
    Set copyToRange = ws.ActiveCell
    
    If sourceRange.Row >= 1 And sourceRange.Column >= 1 And _
       criteriaRange.Row >= 1 And criteriaRange.Column >= 1 And _
       copyToRange.Row >= 1 And copyToRange.Column >= 1 Then
        sourceRange.Resize(11, 6).AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=criteriaRange.Resize(2, 6), _
            CopyToRange:=copyToRange, Unique:=False
    Else
        MsgBox "筛选相关区域超出工作表范围，请调整选中位置"
        Exit Sub
    End If
End Sub

内容的提问来源于stack exchange，提问作者Творческий Псевдоним