Excel VBA @數量計算表-2

有關上回所提到的 Excel VBA @數量計算表 經八河局沈大哥提點，為求符合一般工程使用還是更完善的函數來解決某些問題。

1.數量計算式中需要有中文字以提醒使用者現在正在計算什麼項目。

2.使數量計算式的結果透過函數處理後，如原本連結其他欄位跑出計算結果。

圖一、沈大哥提供的檔案。

P.S: H欄位的黃色網底部分為C1所需要的基本資料，個別註解的部分為單位。

程式運作流程：

1.  E欄填寫 =H18*H9*H15 

2.  C欄填寫 =DetailSum(FORMULATEXT(E3)

3.  D欄填寫 =Eval(C3)

FORMULATEXT可將參考欄位的公式計算結果轉成公式輸出，屬於Excel的內建函數。

DetailSum可將輸出公式的字串取得其數值跟單位，屬於自訂函數。

Eval可取得計算結果，屬於自訂函數。

有關各項原始碼如下：

Function Eval(ByVal s As String)

Dim cal As String

For i = 1 To Len(s)

ch = Mid(s, i, 1)

If IsNumeric(ch) Then '判斷是否為數字

cal = cal + ch

ElseIf ch = "(" Or ch = "[" Or ch = "{" Then  '左括弧

cal = cal + "("

ElseIf ch = ")" Or ch = "]" Or ch = "}" Then    '右括弧

cal = cal + ")"

ElseIf ch = "+" Or ch = "-" Or ch = "*" Or ch = "/" Then '運算符

cal = cal + ch

ElseIf ch = "." Then '其他項目

cal = cal + ch

End If

Next

Eval = Application.Evaluate(cal)

End Function

Function DetailSum(ByVal s As String)

Dim ref As String

s = Right(s, Len(s) - 1)

arr = Array("+", "-", "*", "/", "(", ")", "[", "]", "{", "}")

For i = 1 To Len(s)

ch = Mid(s, i, 1)

IsLeaved = False

For j = LBound(arr) To UBound(arr)

If ch = arr(j) Then

IsLeaved = True
Exit For

End If

Next

If IsLeaved = False Then

ref = ref & ch

Else

Amount = Range(ref)
Unit = Range(ref).Comment.Text

Item = Item & Amount & Unit & ch

ref = ""

End If

If i = Len(s) Then

Amount = Range(ref)
Unit = Range(ref).Comment.Text

Item = Item & Amount & Unit
End If

Next

DetailSum = Item

End Function