Function return value as excel formula

问题

I am trying to convert a formula created by function to return as a formula instead of function brackets. As shown in screenshot attached.

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

I am trying to convert a formula created by function to return as a formula instead of function brackets. As shown in screenshot attached:

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

回答1:

As JvdV pointed out there is the Range.Precedents property which returns all cells the range depends on. So we can loop through these cells and take their addresses to replace them with values (see below example).

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

^{Procedure 1: This can convert simple formulas but you cannot use it in a UDF!}

But this does not work in a user defined function, only in a procedure that is eg called by a button or shortcut. Also this does only work for simple formulas like you showed.

For example it can convert

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

into

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

But if you have a more complicated formula like

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

This approach cannot be used anymore. Also if the formula contains other functions that accept ranges (eg SUM()), your whole idea cannot work anymore.

Because for example =SUM(H16:H18) cannot be converted into values.

If you need to do this in a UDF (user defined function) this would only be possible to be solved by parsing the formula. But be aware that this is much more complicated and a way too broad to be answered here.

Alternative approache that may work: Use named ranges for your values. For example:

^{Image 1: The cell H17 with value 1.4 is named Mass and the cell H18 with value 2 is named SpeedOfLight (named ranges).}

The formula for the cell H19 "Energy" can then be written as =H17*H18^2 or because we use named ranges =Mass*SpeedOfLight^2.

Then you can use the FORMULATEXT() function to turn this formula into text and if you like replace * with ×.

^{Image 1: The formula used is: =SUBSTITUTE(FORMULATEXT(H19),"*","×").}

回答2:

Like already mentioned by Peh, here a solution with parsing the formula. This solution may suit your needs but is not full proof. Some functions in the functions will be evaluated as one value.

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

来源：https://stackoverflow.com/questions/58602734/function-return-value-as-excel-formula

标签

excel

vba

function

excel-formula