excel - 如何在vba中获得具有实际价值的公式？

Question

我正在用 excel 编写vba代码，而且我是新手:)

请帮我解决以下问题：

• 我在单元格A1中有一个公式=B1*C1*D1
• 单元格B1，C1并D1具有各自的值（即 3,2,1）

我想将公式作为字符串 - 即=3*2*1- 使用 VBA

Answer 1

你可以使用

• 用于解析所有非数学运算符部分的正则表达式
• 然后Evaluate所有这些字符串部分

它可能需要处理复杂的字符串，但它是一个好的开始

更新了更复杂的匹配

代码

Sub ParseEm()
Dim strIn As String
Dim strNew As String
Dim strCon As String
Dim lngCnt As Long

Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object

strCon = "|"
Set objRegex = CreateObject("vbscript.regexp")

With objRegex
    .Pattern = "[^=/+/\/-/*\^]+"
    .Global = True
    strIn = [a1].Formula
    If .test(strIn) Then
        Set objRegMC = .Execute(strIn)
        For Each objRegM In objRegMC
        strNew = Evaluate(CStr(objRegM))
        If objRegM.Length >= Len(strNew) Then
        Mid$(strIn, objRegM.firstindex + 1 + lngCnt, objRegM.Length) = strNew & Application.Rept(strCon, objRegM.Length - Len(strNew))
        Else
           strIn = Left$(strIn, objRegM.firstindex + lngCnt) & strNew & Right$(strIn, Len(strIn) - objRegM.firstindex - objRegM.Length - lngCnt - 1)
        lngCnt = lngCnt + Len(strNew) - objRegM.Length
        End If
        Next
        strIn = Replace(strIn, strCon, vbNullString)
        MsgBox strIn
    Else
        MsgBox "sorry, no matches"
    End If
End With
End Sub

Answer 2

我知道的唯一方法是使用以下Precedents功能：

Sub GetFormulaAsString()
    Dim var As Range, temp As String, formulaAsString As String

    temp = "="

    For Each var In Range("A1").Precedents
        temp = temp & var & "*"
    Next var

    formulaAsString = VBA.Left$(temp, Len(temp) - 1) // "=3*2*1"
End Sub

Answer 3

我已经解决了这个问题，伪是：

1. 查找字符串 a1 b1 c1

2. ="="&b1&"*"&c1&"*"&d1在单元格 a1 中制作这样的新公式

3. 获取 a1 的值

不错？:)

Answer 4

想法是用它的值替换 .Formula 属性中单元格的引用。唯一的问题是公式中的 $ 符号，因此添加了 cA 和 rA 循环。

Sub GetFormulaAsString()
    Dim var As Range
    Dim temp As String
    Dim R As Range
    Dim v As Variant
    Dim cA As Integer
    Dim rA As Integer
    Dim cellname As String

    Set R = Range("A1")
    temp = R.Formula
    Debug.Print temp

    For Each var In R.DirectPrecedents
        v = var.Value
        For cA = 1 To 0 Step -1
            For rA = 1 To 0 Step -1
                cellname = var.Address(cA, rA)
                temp = Replace(temp, cellname, v)
            Next rA
        Next cA

    Next var

    Debug.Print temp
    msgbox temp
End Sub