繁体   English   中英

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

[英]Pasting Formula from an Array in VBA into an excel table

所以我正在尝试制作一个 VBA 脚本,将选择中的所有间接公式更改为直接引用,目的是提高我的 excel 工作簿的性能。 下面是代码:

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. 因此,如果您有一个公式“间接(“A1:B2”)”,那么这个 function 的结果将是“A1:B2”。

整个脚本适用于正常范围,除非我尝试在 excel 表的列上运行,其中选择还包括该列的第一个单元格(数据的第一个单元格,所以不是标题)然后结果是该列中的所有单元格都具有与第一个单元格相同的公式。 同样有趣的是,如果我 select 表格中除第一个列之外的所有单元格,那么结果很好,但只有当第一个单元格也涉及时,才会出现问题。 它显然看起来像一些自动填充功能,但我已经关闭了我能找到的所有此类设置,但这个问题仍然没有解决。

好的,我在下面添加了一个更简单的 VBA 代码版本来突出我的问题:

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

上面的代码工作得很好,但是下面的代码导致“= 2 + 2”作为我表格每个单元格的公式。

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

excel 中的表看起来像这样: Excel 表

我找到了一个适用于我检查的所有情况的解决方案,但它并不漂亮 - 将其视为一种解决方法:

  1. 设置Application.AutoCorrect.AutoFillFormulasInLists = False
  2. 通过循环将公式设置为单元格(一个接一个)

如果选择与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

希望其他人会粘贴一个更直接的解决方案!

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM