如何在vba中获得具有真实价值的公式?
我在Excel中写入VBA代码,我是新的:)
请帮我解决以下问题:
- 我在
A1
=B1*C1*D1
单元格中有一个公式 - 单元
B1
,C1
和D1
具有相应的值(即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
我知道的唯一方法是使用Precedents
function:
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
我已经做了这个问题,伪造是:
-
findstringa1 b1 c1
-
在单元格a1中创build新的公式如下
="="&b1&"*"&c1&"*"&d1
-
得到a1的值
不错? 🙂