将 VBA 中的数组中的公式粘贴到 excel 表中

Question

So I am trying to make a VBA scripts that changes all indirect formula in a selection into direct reference, aim is to improve performance of my excel workbook. Below is the code:

Call manual
Dim continue As Integer
continue = MsgBox("This cannot be undone.  Continue anyway?", vbOKCancel)
If continue <> vbOK Then Exit Sub

Dim formula_array() As Variant

row_cnt = Selection.Rows.count
col_cnt = Selection.Columns.count

ReDim formula_array(1 To row_cnt, 1 To col_cnt)

If row_cnt = 1 And col_cnt = 1 Then
    formula_array(1, 1) = Selection.formula
Else
    formula_array = Selection.formula
End If
'for some reason formula_array = Selection.formula gives an error when I select only one cell
count = 0
Dim i As Integer, y As Integer
For i = 1 To row_cnt
    For y = 1 To col_cnt
        frmula = formula_array(i, y)
        oldfunc = find_full_formula(frmula, "indirect(")
        Do While (oldfunc <> "")
            newfunc = Application.Evaluate(oldfunc)
            If IsError(newfunc) Then
                newfunc = ""
            End If
            oldfunc = "indirect(" & oldfunc & ")"
            formula_array(i, y) = Replace(formula_array(i, y), oldfunc, newfunc, 1, -1, vbTextCompare)
            frmula = formula_array(i, y)
            oldfunc = find_full_formula(frmula, "indirect(")
            count = count + 1
        Loop
    Next y
Next i
Dim temp As String
Selection.formula = formula_array
MsgBox count
Call auto

Here the find_full_formula function gives arguments of any function, input is the start of that function and the whole formula. So if you have a formula"Indirect("A1:B2")" then the result of this function would be "A1:B2".

The whole script works very well for normal ranges except when I try to run in on a column of an excel table where the selection also includes the first cell of the column (first cell of data, so not the header) then the result is that all cells in that column have the same formula as the first cell. What is also interesting is that if I select all cells of a column of the table except the first one then the result is fine but only when the first cell is also involved then the problem arises. It obviously looks like some auto-fill feature but I have turned off all such settings that I could find and still this issue isn't solved.

okay, I am adding below a much simpler version of VBA code to highlight my problem:

Dim arr(1 To 4, 1 To 1) As Variant
arr(1, 1) = "2+2"
arr(2, 1) = "=3+2"
arr(3, 1) = "=4+2"
arr(4, 1) = "=5+2"
Range("A2:A5").Formula = arr

this code above works just fine, however the one below results in "=2+2" as formula for each cell of my table.

Dim arr(1 To 4, 1 To 1) As Variant
arr(1, 1) = "=2+2"
arr(2, 1) = "=3+2"
arr(3, 1) = "=4+2"
arr(4, 1) = "=5+2"
Range("A2:A5").Formula = arr

Table in excel looks something like this: Excel Table

Answer 1

I found a solution that works in all cases I checked out, but it's not beautiful - consider it as a workaround:

1. set Application.AutoCorrect.AutoFillFormulasInLists = False
2. set formula to cells by looping them (one by one)

None of these alone sets the formulas as expected if selection matches a ListObject.DataBodyRange .

Sub Test()
    ' select a range that fits
    ' the following arrays dimensions

    Dim arr(1 To 4, 1 To 2) As Variant
    arr(1, 1) = "=2+2": arr(1, 2) = "=12+2"
    arr(2, 1) = "=3+2": arr(2, 2) = "=13+2"
    arr(3, 1) = "=4+2": arr(3, 2) = "=14+2"
    arr(4, 1) = "=5+2": arr(4, 2) = "=15+2"

    ' deactivate AutoFillFormulasInLists; store setting to restore
    Dim bAutoFill As Boolean
    bAutoFill = Application.AutoCorrect.AutoFillFormulasInLists
    Application.AutoCorrect.AutoFillFormulasInLists = False

    Selection.ClearContents

    ' `Selection.FormulaR1C1 = arr` does NOT work in case of
    ' Selection = ListObject.DataBodyRange
    ' => loop cells (slower and more lines of code)

    Dim i As Long, j As Long
    For i = 1 To UBound(arr, 1)
        For j = 1 To UBound(arr, 2)
            Selection(i, j).FormulaR1C1 = arr(i, j)
        Next j
    Next i

    Application.AutoCorrect.AutoFillFormulasInLists = bAutoFill
End Sub

Hopefully somebody else will paste a more straightforward solution!