函数返回值作为excel公式

Question

我正在尝试将函数创建的公式转换为作为公式而不是函数括号返回。如附件截图所示。

Function f2t2(rng As Range) As String

    Application.ScreenUpdating = False

    jGetFormula = rng.Formula
    jGetFormula = Replace(jGetFormula, "(", """" & "(" & """" & "&")
    jGetFormula = Replace(jGetFormula, ")", "&" & """" & ")" & """" & "&")
    jGetFormula = Replace(jGetFormula, "+", "&" & """" & "+" & """" & "&")
    jGetFormula = Replace(jGetFormula, "-", "&" & """" & "-" & """" & "&")
    jGetFormula = Replace(jGetFormula, "*", "&" & """" & Chr(215) & """" & "&")
    jGetFormula = Replace(jGetFormula, "/", "&" & """" & "/" & """" & "&")
    jGetFormula = Replace(jGetFormula, "^", "&" & """" & "^" & """" & "&")
    jGetFormula = Replace(jGetFormula, "&&", "&")

    If (Right(jGetFormula, 1) = "&") Then
        jGetFormula = Left(jGetFormula, (Len(jGetFormula) - 1))
    End If

    'MsgBox jGetFormula
    'recalcualting other formulas in the excel
    Application.Volatile

    'Returning to excel
     f2t2 = jGetFormula

    'f2t = jGetFormula
    Application.ScreenUpdating = True
    Application.StatusBar = ""
End Function

我正在尝试将函数创建的公式转换为作为公式而不是函数括号返回。如附件截图所示：

Sub Formula_Edit(Optional endAll As Boolean = False)

MsgBox "3"
Range("T101").Value = 5
If endAll Then End
MsgBox "4"
End Sub

Function call2()
MsgBox "1"
Call Formula_Edit(True)
MsgBox "2"
End Function

Answer 1

正如 JvdV 指出的那样，Range.Precedents property 返回范围所依赖的所有单元格。因此我们可以遍历这些单元格并获取它们的地址以将它们替换为值（参见下面的示例）。

Sub test()
    Dim rng As Range
    Set rng = Range("H19")

    Dim Output As String
    Output = "'" & rng.Formula
    Output = Replace$(Output, "*", "×")

    Dim r As Range
    For Each r In rng.Precedents
        Output = Replace$(Output, r.Address(RowAbsolute:=False, ColumnAbsolute:=False), r.Value) 'H16
        Output = Replace$(Output, r.Address(RowAbsolute:=True, ColumnAbsolute:=False), r.Value)  'H$16
        Output = Replace$(Output, r.Address(RowAbsolute:=False, ColumnAbsolute:=True), r.Value)  '$H16
        Output = Replace$(Output, r.Address(RowAbsolute:=True, ColumnAbsolute:=True), r.Value)   '$H$16
    Next r

    Range("H20").Value = Output
End Sub

^{程序 1：这可以转换简单的公式，但您不能在 UDF 中使用它！}

但这在用户定义的函数中不起作用，仅在由按钮或快捷方式调用的过程中起作用。这也仅适用于您展示的简单公式。

例如它可以转换

=H16*H17+H18-(H17/H18)

进入

'=1×1.4+2-(1.4/2)

但是如果你有一个更复杂的公式，比如

=Sheet2!H16*Sheet3!H17+H18-(H17/H18)

这种方法不能再使用了。此外，如果公式包含接受范围的其他函数（例如 SUM()），那么您的整个想法就不再适用了。

因为例如=SUM(H16:H18)不能转换成值。

---

如果您需要在 UDF（用户定义函数）中执行此操作，则只能通过解析公式来解决。但请注意，这要复杂得多，而且范围太广，无法在这里回答。

---

可能有效的替代方法： 为您的值使用命名范围。例如：

^{图 1：值为 1.4 的单元格 H17 命名为 Mass，值为 2 的单元格 H18 命名为 SpeedOfLight（命名范围）。}

单元格 H19“能量”的公式可以写成=H17*H18^2，或者因为我们使用命名范围=Mass*SpeedOfLight^2。

然后您可以使用FORMULATEXT() 函数将此公式转换为文本，如果您喜欢将* 替换为×。

^{图 1：使用的公式为：=SUBSTITUTE(FORMULATEXT(H19),"*","×")。}

Answer 2

就像 Peh 已经提到的，这里有一个解析公式的解决方案。 此解决方案可能适合您的需求，但并非完全证明。函数中的某些函数将被评估为一个值。

Function f2t2(rng As Range) As String
    x = rng.Formula
        For Each del In Array(";", " ", ".", "<", ">", "+", "-", "=", "/", "\", "*", "^") '":","(", ")"
            x = Replace(x, del, "|")
        Next del
            arr1 = Split(x, "|")
            arr2 = arr1

        For i = LBound(arr1) To UBound(arr1)
            On Error Resume Next
            arr2(i) = IIf(Application.Evaluate(arr1(i)) = "", "0", Application.Evaluate(arr1(i)))
            On Error GoTo 0
        Next i

    x = rng.Formula
        For i = LBound(arr1) To UBound(arr1)
            x = Replace(x, arr1(i), arr2(i))
        Next

    f2t2 = x

End Function