如何在vba中获得具有真实价值的公式?

我在Excel中写入VBA代码,我是新的:)

请帮我解决以下问题:

  • 我在A1 =B1*C1*D1单元格中有一个公式
  • 单元B1C1D1具有相应的值(即3,2,1)

我想用公式作为一个string – 即=3*2*1 – 使用VBA

你可以使用

  • parsing出所有非math运算符部分的正则expression式
  • 然后Evaluate所有这些string部分

它可能需要复杂的string,但它是一个好的开始

更新更复杂的匹配

在这里输入图像说明

 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 

我知道的唯一方法是使用Precedentsfunction:

 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 

想法是用“值”来replace.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 

我已经做了这个问题,伪造是:

  1. findstringa1 b1 c1

  2. 在单元格a1中创build新的公式如下="="&b1&"*"&c1&"*"&d1

  3. 得到a1的值

不错? 🙂