VBA自定义WriteRangeToTable函数无法保留公式写入表格问题求助

你的代码存在3个核心问题导致无法正常运行，且不能保留公式：

• 误用Set关键字：Set仅用于给VBA中的对象变量赋值，给单元格区域写入内容属于属性赋值操作，不需要加Set，这是代码运行报错的核心原因
• 空表写入逻辑错误：当表格没有数据行时，InsertRowRange仅代表待插入的单行占位，直接Resize不会自动新增多行，需要先调用ListRows.Add批量插入对应数量的空行
• 未指定赋值属性：直接给区域赋值默认写入的是单元格静态值，会把公式转换为结果，要保留公式需要指定写入Formula属性

Function WriteRangeToTable(InputRange As Range, TableName As String, SheetName As String)
    Dim MyTable As ListObject
    Dim TargetRange As Range
    
    Set MyTable = Worksheets(SheetName).ListObjects(TableName)
    
    ' 可选校验：输入区域和表格列数匹配校验
    If InputRange.Columns.Count <> MyTable.ListColumns.Count Then
        Err.Raise vbObjectError + 1001, , "输入区域的列数与表格列数不匹配"
        Exit Function
    End If
    
    ' 处理目标写入区域
    If MyTable.DataBodyRange Is Nothing Then
        ' 空表先插入对应行数
        MyTable.ListRows.Add Count:=InputRange.Rows.Count
        Set TargetRange = MyTable.DataBodyRange
    Else
        ' 已有数据时调整表格行数到对应大小
        If MyTable.ListRows.Count <> InputRange.Rows.Count Then
            MyTable.DataBodyRange.Delete
            MyTable.ListRows.Add Count:=InputRange.Rows.Count
        End If
        Set TargetRange = MyTable.DataBodyRange
    End If
    
    ' 写入公式，完整保留原公式结构
    TargetRange.Formula = InputRange.Formula
End Function

• 如果需要同时保留单元格格式、批注等其他属性，可以改用InputRange.Copy TargetRange的写法，属性保留效果更好
• 如果不需要保留原有表格的旧数据，可以直接删除旧数据行后再插入新行，避免数据残留

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