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

Question

我在excel中编写vba代码，我是新手：）

请帮我解决以下问题：

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

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

Answer 1

您可以使用

• 一个regexp来解析所有非数学运算符部分
• 然后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

想法是用'值'替换.Formula属性中的单元格引用。唯一的麻烦是使用$ sign in 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

Answer 4

我已经完成了这个问题，伪是：

1. 查找字符串a1 b1 c1

2. 在单元格a1

制作新的公式="="&b1&"*"&c1&"*"&d1

3. 获取a1

的值 不好吗？ ：）