Private Sub Worksheet_Change(ByVal Target As Range)
Dim expression As String, Result As Double
If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
If Target.Count = 1 Then
If Target.Value <> "" Then
If InStr(Target, ":") > 0 Then
expression = Trim(Split(Target.Value, ":")(1))
Else
expression = Trim(Target.Value)
End If
expression = Replace(expression, ",", ".")
Application.EnableEvents = False
On Error GoTo end_
Result = Evaluate(expression) 'Target.Offset(, 1).Value = result
Target.Value = "'" & Trim(Target.Value) & " = " & FormatWithComma(Result)
ToSumRange Target
End If
End If
End If
end_:
Application.EnableEvents = True
End Sub
''-----------------------------------------------------------------------
Private Function FormatWithComma(ByVal number As Double) As String
Dim text As String, Result As String
text = Format(2001 / 2, "#,##0.0")
Result = Format(number, "#,##0.0##")
If Mid(text, 6, 1) = "," Then
FormatWithComma = Replace(Result, Mid(text, 2, 1), ".")
Else
Result = Replace(Result, ".", "@")
Result = Replace(Result, Mid(text, 2, 1), ".")
FormatWithComma = Replace(Result, "@", ",")
End If
End Function
''-----------------------------------------------------------------------
Private Sub ToSumRange(taR As Range)
Dim k As Long, pos As Long, text As String, Result As Double
i = 0
text = taR.Offset(i).Value
pos = InStr(1, text, "=")
Do While pos > 0
text = Replace(Replace(Trim(Mid(text, pos + 1)), ".", ""), ",", ".")
Result = Result + Val(text)
i = i - 1
text = taR.Offset(i).Value
pos = InStr(1, text, "=")
Loop
k = i
i = 1
text = taR.Offset(i).Value
pos = InStr(1, text, "=")
Do While pos > 0
text = Replace(Replace(Trim(Mid(text, pos + 1)), ".", ""), ",", ".")
Result = Result + Val(text)
i = i + 1
text = taR.Offset(i).Value
pos = InStr(1, text, "=")
Loop
taR.Offset(k, 2) = Result
End Sub