mình có sưu tập được 1 file này có thể đáp ứng được yêu cầu của bạn nhưng mình không biết làm thế nào để chuyển hoàn toàn sang tiếng việt được, nhờ mấy bác cao thủ xem giúp và hướng dẫn sử dụng cụ thể luôn nhé
http://www.fshare.vn/file/48C9L4AMVU/http://www.fshare.vn/file/48C9L4AMVU/
theo mình biết thì hàm này sử dụng giống như hàm dvalue nhưng tính được luôn sin, cos và dấu , dấu .
rất mong được sự giúp đỡ của các Pro
đây là toàn bộ code của nó
'
' Textcalc Version1.30 (C)1996-2000, peace
'
Option Explicit
Private Token As String
Private TokenType As Integer '1
ELIMITER 2:NUMBER 3:FUNCTION
Private S As String
Private SLen As Integer
Private GP As Integer
Private KAKKO As Integer
Const DELIMITA As String = "+-*/()^"
Const NUMBER As String = "0123456789"
Const RAD As Double = 57.2957795130823
' ŠÖ”‚̃Gƒ“ƒgƒŠƒ|ƒCƒ“ƒg
Function TEXTCALC(S2 As String) As Double
S2 = StrConv(S2, vbNarrow)
S2 = StrConv(S2, vbLowerCase)
S2 = Application.Substitute(S2, " ", "")
S2 = Application.Substitute(S2, "~", "*")
S2 = Application.Substitute(S2, "×", "*")
S2 = Application.Substitute(S2, "€", "/")
S2 = Application.Substitute(S2, "=", "")
S2 = Application.Substitute(S2, "ã", "sqrt")
S2 = Application.Substitute(S2, ",", "")
S2 = Application.Substitute(S2, "{", "(")
S2 = Application.Substitute(S2, "}", ")")
S2 = Application.Substitute(S2, "[", "(")
S2 = Application.Substitute(S2, "]", ")")
S2 = Application.Substitute(S2, "ƒÎ", "3.14159265358979")
S2 = Application.Substitute(S2, "pi", "3.14159265358979")
S2 = Application.Substitute(S2, "rad", "57.2957795130823")
KAKKO = 0
GP = 1
S = S2
SLen = Len(S)
GetToken
TEXTCALC = sub1(0#)
If (KAKKO <> 0) Then
MsgBox "Š‡ŒÊ‚ÌŽw’è‚ÉŒë‚肪‚ ‚è‚Ü‚·B" _
, vbOKOnly + vbExclamation, "TEXTCALC"
TEXTCALC = 1 / 0
End If
End Function
' ‰ÁŽZEŒ¸ŽZ‚̈—
Function sub1(Value As Double) As Double
Dim Value2 As Double
Dim Token2 As String
Value = sub2(Value)
While Token = "+" Or Token = "-"
Token2 = Token
GetToken
Value2 = sub2(Value2)
Select Case Token2
Case "+"
Value = Value + Value2
Case "-"
Value = Value - Value2
End Select
Wend
sub1 = Value
End Function
' æŽZAœŽZ‚̈—
Function sub2(Value As Double) As Double
Dim Value2 As Double
Dim Token2 As String
Value = sub3(Value)
While Token = "*" Or Token = "/"
Token2 = Token
GetToken
Value2 = sub3(Value2)
Select Case Token2
Case "*"
Value = Value * Value2
Case "/"
Value = Value / Value2
End Select
Wend
sub2 = Value
End Function
' ‚ׂ«æ‚̈—
Function sub3(Value As Double) As Double
Dim Value2 As Double
Dim Token2 As String
Value = sub4(Value)
While Token = "^"
Token2 = Token
GetToken
Value2 = sub4(Value2)
Select Case Token2
Case "^"
Value = Value ^ Value2
End Select
Wend
sub3 = Value
End Function
' ’P€‰‰ŽZŽq‚̈—
Function sub4(Value As Double) As Double
Dim Token2 As String
If Token = "+" Or Token = "-" Then
Token2 = Token
GetToken
End If
Value = sub5(Value)
If Token2 = "-" Then
Value = -Value
End If
sub4 = Value
End Function
' Š‡ŒÊ‚̈—
Function sub5(Value As Double) As Double
If Token = "(" Then
GetToken
Value = sub1(Value)
GetToken
Else
Value = Atom()
End If
sub5 = Value
End Function
' ”’l‚̈—
Function Atom() As Double
Dim temp As String
Dim i As Integer
Dim Value2 As Double
If TokenType = 3 Then
Atom = Func(Token)
ElseIf TokenType = 2 Then
Atom = Val(Token)
GetToken
End If
End Function
'ŽZpŠÖ”‚̈—
Function Func(str As String) As Double
Dim Value2 As Double
Dim str2 As Double
Select Case str
Case "sin"
GetToken
Value2 = sub4(Value2)
Func = Sin(Value2 / RAD)
Case "cos"
GetToken
Value2 = sub4(Value2)
Func = Cos(Value2 / RAD)
Case "tan"
GetToken
Value2 = sub4(Value2)
Func = Tan(Value2 / RAD)
Case "asin"
GetToken
Value2 = sub4(Value2)
Func = WorksheetFunction.Asin(Value2) * RAD
Case "acos"
GetToken
Value2 = sub4(Value2)
Func = WorksheetFunction.Acos(Value2) * RAD
Case "atan"
GetToken
Value2 = sub4(Value2)
Func = Atn(Value2) * RAD
Case "abs"
GetToken
Value2 = sub4(Value2)
Func = Abs(Value2)
Case "int"
GetToken
Value2 = sub4(Value2)
Func = Int(Value2)
Case "exp"
GetToken
Value2 = sub4(Value2)
Func = Exp(Value2)
Case "log"
GetToken
Value2 = sub4(Value2)
Func = Log(Value2)
Case "sqrt"
GetToken
Value2 = sub4(Value2)
Func = Sqr(Value2)
Case Else
MsgBox "ŠÖ” " + str + " ‚Í’è‹`‚³‚ê‚Ä‚¢‚Ü‚¹‚ñB" _
, vbOKOnly + vbExclamation, "TEXTCALC"
Func = 1 / 0
End Select
End Function
' ƒg[ƒNƒ“‚ÌØo‚µ
Function GetToken()
Dim i As Integer
If GP > SLen Then
Token = ""
Exit Function
End If
If InStr(DELIMITA, Mid(S, GP, 1)) <> 0 Then
Token = Mid(S, GP, 1)
TokenType = 1
GP = GP + 1
If Token = "(" Then 'Š‡ŒÊ‚̃`ƒFƒbƒN
KAKKO = KAKKO + 1
ElseIf Token = ")" Then
KAKKO = KAKKO - 1
End If
ElseIf InStr(NUMBER, Mid(S, GP, 1)) <> 0 Then
For i = GP To SLen
If InStr(DELIMITA, Mid(S, i, 1)) <> 0 Then
Exit For
End If
Next
Token = Mid(S, GP, i - GP)
TokenType = 2
GP = i
Else
For i = GP To SLen
If InStr(DELIMITA, Mid(S, i, 1)) <> 0 Then
Exit For
End If
Next
Token = Mid(S, GP, i - GP)
TokenType = 3
GP = i
End If
End Function