Excel VBA代码因工作表分组/拆分触发运行时错误1004求助

你的代码触发Run-time error 1004的核心原因是：分组折叠状态下，隐藏的单元格无法被Select选中。手动取消分组后单元格可见，Select就能正常执行，但你用内置取消分组命令无效，大概率是没覆盖全部分组层级；另外，Select本身就是完全没必要的操作——VBA操作单元格根本不需要先选中它。

最优修复方案：移除Select和Selection #

直接对单元格对象设置格式，跳过选中步骤，这不仅能解决分组导致的错误，还能提升代码运行效率。修改后的代码如下：

Sub Dates()
    Dim wbDB As Workbook, wbR As Workbook
    Dim wsDB As Worksheet, wsR As Worksheet
    Dim rngDB As Range, rngR As Range
    Dim j As Long, i As Long, lr As Long
    Dim RES As Variant ' Match返回值可能是错误，用Variant类型

    Set wbDB = Workbooks("DASHBOARD.xlsx")
    Set wsDB = wbDB.Worksheets("Sheet1")
    Set rngDB = wsDB.Range("A:V")

    Set wbR = Workbooks("DATE.xlsm")
    Set wsR = wbR.Worksheets("ENTRY")
    Set rngR = wsR.Range("A:AK")

    j = rngR(rngR.Rows.Count, "E").End(xlUp).Row
    
    ' 提前获取数据最后一行，避免循环内重复计算（优化效率）
    lr = rngDB(rngDB.Rows.Count, "B").End(xlUp).Row
    
    For i = 2 To j
        RES = Application.Match(wsR.Range("E" & i).Value, wsDB.Range("B1:B" & lr), 0)
        
        If Not IsError(RES) Then
            If IsEmpty(wsR.Range("U" & i).Value) Then
                wsR.Range("U" & i).Value = wsDB.Range("R" & RES)
                ' 直接设置格式，无需Select
                wsR.Range("U" & i).NumberFormat = "D-MMM"
            End If
            
            If IsEmpty(wsR.Range("W" & i).Value) Then
                wsR.Range("W" & i).Value = wsDB.Range("S" & RES)
                ' 直接设置格式，无需Select
                wsR.Range("W" & i).NumberFormat = "D-MMM"
            End If
        End If
    Next i
End Sub

额外优化点 #

• 修正变量声明：原代码中Dim wbDB, wbR As Workbook实际只有wbR是Workbook类型，wbDB为Variant，现在改为正确的分别声明方式。
• 把lr的计算移到循环外，避免每次循环重复读取最后一行，提升运行速度。
• 明确RES为Variant类型，因为Application.Match找不到匹配时会返回错误值，Variant类型能兼容两种结果。

如果确实需要先取消分组（可选） #

如果你因为其他需求必须确保工作表无分组，可以在代码开头添加取消全部分组的语句：

' 取消所有行分组（Excel最多支持8级行分组）
wsR.Outline.ShowLevels RowLevels:=8
' 取消所有列分组
wsR.Outline.ShowLevels ColumnLevels:=8

这条语句会展开所有层级的分组，确保所有单元格可见，解决Select的问题，但还是推荐直接移除Select的方案，更简洁高效。

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