如何将包含公式和值的列复制到 Excel ListObject 表？答案

【问题标题】：How to copy a column containing formulae and values to an Excel ListObject table?如何将包含公式和值的列复制到 Excel ListObject 表？
【发布时间】：2021-02-28 14:51:13
【问题描述】：

我有一个带有计算列的 Excel 表 (ListObject)，但是，有些公式被值覆盖了。

我正在尝试将所有行读入一个数组，进行一些更改（包括添加新行），然后将修改后的数据放回表中。

我的问题是，当我这样做时，计算列中的任何覆盖值都会丢失，因为它们会被原始公式替换。

如何防止这种行为，同时仍将公式填充到新添加的行中？

请注意，这是一个非常简化的示例。实际上，有很多半计算列，如果可以避免，我不想在代码中重新编写每一列的公式。

我目前的简化代码如下：

Dim Tbl As ListObject
Set Tbl = ThisWorkbook.Sheets("Sheet1").ListObjects("Tbl")

''copy current tbl into array
Dim Arr As Variant
Arr = Tbl.DataBodyRange.Formula

''make changes to the array

''copy back from array to tbl
Tbl.DataBodyRange.Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr

谢谢。

【问题讨论】：

我认为您将不得不修改那些直接在工作表上“覆盖”计算公式的值。例如。 Tbl.DataBodyRange(5, 3).FormulaR1C1 = "newValue"
不。那是行不通的……有超过 10,000 行和 20 多列。它已经运行得太慢了。循环遍历每个单元格以检查它是否是公式，然后将每个不是的单元格单独写入工作表将花费太长时间。
您可以通过检查数组以查看它是否以等号开头来节省一些时间。或者您可以将公式转换为范围，然后再返回。或者也许其他人会想出更好的答案。
这不是检查它们是否是需要时间的公式，而是必须将它们单独写入工作表。我想我有一个解决方案，并会发布一个答案，虽然它有点令人费解。

标签： excel vba listobject

【解决方案1】：

我想我已经做到了，尽管对于一些应该相当简单的事情来说似乎有很多工作要做。

在我的测试过程中，我发现只有当我们一次替换表的所有行时，这些值才会被覆盖（不要问我为什么）。

所以，我的解决方案是将数组分两部分复制到表中。

这听起来很简单，但不幸的是，VBA 并没有让处理数组变得特别容易。

为了方便起见，我添加了一个辅助函数：

'Shift' 函数将数组中的所有行“向上”移动 1。

    Function Shift(aRy As Variant)

    Dim iCt As Integer, iUbd As Integer
    
    iCt = LBound(aRy, 1)
    iUbd = UBound(aRy, 1)
    
    Do While iCt < iUbd
        Dim i As Long
        For i = LBound(aRy, 2) To UBound(aRy, 2)
            aRy(iCt, i) = aRy(iCt + 1, i)
        Next i
        iCt = iCt + 1
    Loop

    aRy = transposeArray(aRy)
    ReDim Preserve aRy(1 To UBound(aRy, 1), 1 To UBound(aRy, 2) - 1)
    aRy = transposeArray(aRy)
    
    Shift = aRy

End Function

这个函数使用了一个自定义的transposeArray 函数，因为内置的Application.Transpose 有点受限和有问题。

Function transposeArray(myarr As Variant) As Variant
    Dim myvar As Variant
    ReDim myvar(LBound(myarr, 2) To UBound(myarr, 2), LBound(myarr, 1) To UBound(myarr, 1))
    For i = LBound(myarr, 2) To UBound(myarr, 2)
        For j = LBound(myarr, 1) To UBound(myarr, 1)
            myvar(i, j) = myarr(j, i)
        Next
    Next
    transposeArray = myvar
End Function

最后，我们如何使用它：

''Copy the first row of the array to the first row of the table
Tbl.DataBodyRange.Resize(1, UBound(Arr, 2)).Formula = Arr
''use the shift function to essentially remove the first row of the array.
Arr = Shift(Arr)
''copy the remaining rows to the table, starting at it's 2nd row.
Tbl.DataBodyRange.Resize(UBound(Arr, 1), UBound(Arr, 2)).Offset(1).Formula = Arr

【讨论】：