我来帮你优化这段VBA代码，先拆解原代码里拖慢速度的核心问题，再给出重构后的高效版本：

原代码的性能瓶颈 #

• 循环中逐个复制单个单元格：366次循环就要执行上千次底层操作，这是速度慢的主要原因
• 重复执行冗余操作：每次循环都重新定义rng和执行Match查找，完全没必要
• 嵌套分支过于复杂：多层If逻辑绕，增加了代码维护成本和不必要的判断

优化后的代码 #

Sub AddYearOptimized()
    Dim targetDate As Variant
    Dim lastCol As Long
    Dim matchResult As Variant
    Dim colsToAdd As Long
    Dim ws As Worksheet
    
    ' 提前绑定工作表对象，避免重复引用Sheet11
    Set ws = Sheet11
    
    ' 关闭所有拖慢运行的Excel自动功能
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    ' 错误捕获：确保任何情况下都能恢复Excel设置
    On Error GoTo Cleanup

    ' 第一步：检查B9对应的日期是否存在于第2行
    targetDate = ws.Range("B9").Value
    lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
    matchResult = Application.Match(targetDate, ws.Rows(2), 0)
    
    ' 第二步：如果B9的日期不存在，检查A9的日期
    If IsError(matchResult) Then
        targetDate = ws.Range("A9").Value
        matchResult = Application.Match(targetDate, ws.Rows(2), 0)
    End If
    
    ' 第三步：目标日期不存在则添加一整年的列
    If IsError(matchResult) Then
        colsToAdd = 366 ' 按闰年最多天数设置，平年可改为365
        
        ' 一次性复制1-3行的最后一列，批量粘贴到后续366列
        ws.Range(ws.Cells(1, lastCol), ws.Cells(3, lastCol)).Copy _
            Destination:=ws.Cells(1, lastCol + 1).Resize(3, colsToAdd)
        
        MsgBox "已成功添加一整年的日期列！"
    Else
        MsgBox "年份已存在"
    End If

Cleanup:
    ' 恢复Excel的正常运行设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    Set ws = Nothing
End Sub

关键优化点解析 #

• 批量复制替代循环：把原来366次逐个单元格复制，改成一次性复制整行区域，直接减少99%的Excel交互操作，速度提升非常明显
• 精简冗余操作：只执行两次Match查找，提前绑定工作表对象，避免重复定义相同的Range
• 关闭更多自动功能：除了ScreenUpdating，还关闭了EnableEvents（避免触发工作表事件）和Calculation（手动计算，防止复制时频繁重算公式）
• 错误安全机制：添加On Error GoTo确保即使代码出错，Excel的设置也能恢复正常，不会影响后续操作
• 简化逻辑分支：把嵌套的If合并为线性判断，代码更易读，减少不必要的条件检查

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