如何用vba中的實際值獲得公式？

Question

我寫vba代碼在Excel和我是新:)

請幫我解決以下問題：

• 我在=B1*C1*D1
• 細胞B1細胞A1公式， 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'屬性中的引用。唯一的麻煩是用公式中的$符號，因此添加了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. 使得這樣="="&b1&"*"&c1&"*"&d1新的公式在單元格A1

3. 得到a1的值

不壞？ :)