Excel VBA：如何用TOROW将选中区域数据导入表格新行并保留公式列？

需求可行性结论 #

完全可行，以下是适配任意数据结构、满足所有需求的实现方案。

问题分析 #

原有代码硬编码了单元格偏移量，只能适配固定2×2的区域，灵活性极差。你尝试的Range("newRow")=Application.WorksheetFunction.TOROW(...)无效，原因是newRow是ListRow对象，不能直接作为字符串参数传入Range()函数。

实现代码 #

Sub ImportSelectedDataToTable()
    Dim targetTable As ListObject
    Dim newRow As ListRow
    Dim selectedRange As Range
    Dim flattenedValues As Variant
    Dim colCount As Integer
    Dim i As Integer
    
    ' 验证是否选中了数据区域
    If TypeName(Selection) <> "Range" Then
        MsgBox "请先选中要导入的数据区域！", vbExclamation
        Exit Sub
    End If
    Set selectedRange = Selection
    
    ' 获取当前工作表的目标表格（若有多个表格，可修改为指定名称，比如ListObjects("Table1")）
    On Error Resume Next
    Set targetTable = ActiveSheet.ListObjects(1)
    On Error GoTo 0
    
    If targetTable Is Nothing Then
        MsgBox "当前工作表中未找到表格（ListObject）！", vbExclamation
        Exit Sub
    End If
    
    ' 将选中的任意矩形区域扁平化为一维数组（行优先）
    flattenedValues = Application.WorksheetFunction.TOROW(selectedRange, False)
    colCount = UBound(flattenedValues)
    
    ' 在目标表格新增行
    Set newRow = targetTable.ListRows.Add
    
    ' 仅填充数值，跳过表格原生带公式的列
    For i = 1 To colCount
        ' 检查当前表格列是否为公式列（判断列内第一个数据单元格是否有公式）
        If i <= targetTable.ListColumns.Count And _
           Not targetTable.ListColumns(i).DataBodyRange.Cells(1).HasFormula Then
            newRow.Range.Cells(i).Value = flattenedValues(i)
        End If
    Next i
End Sub

代码关键点说明 #

• 兼容性适配：自动识别选中区域和当前工作表的表格，无需修改代码适配不同数据结构
• 数值仅粘贴：通过直接赋值.Value确保只传入单元格数值，不会携带原区域的公式
• 公式列保留为空：遍历表格列时，跳过原生带有公式的列（通过检查列内第一个数据行单元格的公式状态，表格公式为整列应用）
• 区域扁平化：使用TOROW函数将任意行/列数的选中区域转换为一维数组，完美匹配表格的单行结构

简化赋值（无需跳过公式列场景） #

如果不需要跳过公式列，仅需将选中区域数据导入新行，可简化为以下代码段替代循环部分：

' 仅填充对应数量的单元格，超出表格列数的部分自动忽略
newRow.Range.Resize(1, colCount).Value = flattenedValues

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