Excel VBA运行时错误'1004'：合并单元格循环问题及优化咨询

运行时错误'1004'由三处代码缺陷导致：

• 遍历目标设为整列A，循环到工作表最后一行时，rng.Offset(1, 0)会指向工作表边界外的不存在单元格，触发越界错误
• 合并单元格后通过GoTo MergeCells强制跳回循环起点，会重复遍历已处理区域，既存在死循环风险，也会在已合并区域重复执行合并操作触发报错
• 未设置空白单元格终止判断，会无意义遍历整列所有空行，同时遗漏独立单元格的居中设置要求

保留原代码中色阶设置、自动筛选、行列插入的逻辑，仅替换原有错误的合并单元格段即可，修正后完整代码如下：

Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    Range("L23").Select
    ActiveWindow.SmallScroll Down:=0
    
    ' 修正后的A列日期合并居中逻辑
    Dim lastRow As Long, mergeStart As Long, i As Long
    Application.ScreenUpdating = False
    ' 定位A列最后一个非空有效行，避免遍历整列
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    ' 若日期数据从第2行（表头行下）开始，把下面的1改成2即可
    mergeStart = 1
    
    For i = mergeStart To lastRow
        ' 遇到空白单元格直接终止合并逻辑，跳转执行后续任务
        If Cells(i, "A").Value = "" Then Exit For
        
        ' 检测到连续日期块的终点
        If Cells(i, "A").Value <> Cells(i + 1, "A").Value Then
            ' 对当前连续块执行合并+居中，单格独立日期也会触发该逻辑完成居中设置
            With Range(Cells(mergeStart, "A"), Cells(i, "A"))
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            ' 标记下一个连续块的起始行
            mergeStart = i + 1
        End If
    Next i
    Application.ScreenUpdating = True

    ' 原有后续逻辑保持不变
    ActiveWindow.SmallScroll Down:=0
    Rows("1:1").Select
    Selection.AutoFilter
    Rows("1:5").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells.Select
    With Selection.Font

• 提前定位A列有效数据边界，从根源避免单元格越界触发的1004错误
• 逐行顺序遍历，移除易造成死循环的GoTo跳转，不会重复操作已处理单元格
• 遍历过程中检测到空白单元格立即退出合并循环，直接执行后续自动筛选等任务
• 单格独立的日期值会被识别为长度为1的连续块，自动执行居中设置，满足独立单元格对齐要求

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