Hàm tính giá trị biểu thức DValue

Liên hệ QC
Các bạn sửa lại code giúp trong 2 trường hợp:
6 người x 2.000 đồng/1 ngày nó báo 12(Không hiểu dấu . là phân cách phần nghìn)
6 người x 2.000.000 đồng/1 ngày nó báo lỗi #Value!
 
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:DELIMITER 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


' ‰ÁŽZEŒ¸Ž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


' æŽZAœŽ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


'ŽZpŠÖ”‚̏ˆ—
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
 
Lần chỉnh sửa cuối:
cám ơn ban

Đôi khi ta có những biểu thức có số lẫn chữ và ta muốn tính giá trị của biểu thức đó. Ta dùng hàm DValue, cú pháp : DValue(Biểu_Thức)
Ví dụ :
---------A---------------------------B---------------giá trị trả về
1.-- "6 cái x 10đ" --------------- =DValue(A1) --------- 60
2.-- "5m x 20m" ---------------- =DValue(A2) --------- 100
3.-- "(2hàng+3hàng)*10người" -- =DValue(A3) --------- 50
4.-- "60người : 2 xe" ----------- =Dvalue(A4) ---------- 30

Phép tính nhân có thể là dấu * hoặc x
Phép tính chia có thể là dấu / hoặc :

Mã:
Public Function DValue(Expr)
    Char = Expr
    Sent = Space(0)
    ABC = "0123456789+-*/()." & Space(1)
    XYZ = "0123456789" & Space(1)
    For m = 2 To 3
        Met = "m" & m
        Temp = InStr(1, Char, Met)
        Do While Temp > 0
            If Temp > 0 Then
                Char = Left(Char, Temp) & Mid(Char, Temp + 2)
            End If
            Temp = InStr(1, Char, Met)
        Loop
    Next
    For i = 1 To Len(Char)
        KyTu = Mid(Char, i, 1)
        If InStr(1, ABC, KyTu) > 0 Then
            Sent = Sent & KyTu
        Else
            Select Case KyTu
                Case ":"
                    Left_ = Mid(Char, i - 1, 1)
                    Right_ = Mid(Char, i + 1, 1)
                    If InStr(1, XYZ, Right_) > 0 Then
                        Sent = Sent & "/"
                    End If
                Case ","
                    Sent = Sent & "."
                Case "%"
                    Sent = Sent & "/100"
                Case "x", "X"
                    Left_ = Mid(Char, i - 1, 1)
                    Right_ = Mid(Char, i + 1, 1)
                    If InStr(1, XYZ, Right_) > 0 Then
                        Sent = Sent & "*"
                    End If
            End Select
        End If
    Next
    DValue = Eval(Sent)
End Function
TDN

chân thành cảm ơn bạn, ban đã giúp mình tiết kiệm được 2/3 thời gian làm bài.
 
cho e hỏi sao e sdung cthuws dvalue=(bieuthuc), thì nó xuất hiện lỗi VALUE ah,
ví dụ: A1=9.65kg/m*0.15*8*48, kqa ô B1=dvalue(
 
Đôi khi ta có những biểu thức có số lẫn chữ và ta muốn tính giá trị của biểu thức đó. Ta dùng hàm DValue, cú pháp : DValue(Biểu_Thức)
Ví dụ :
---------A---------------------------B---------------giá trị trả về
1.-- "6 cái x 10đ" --------------- =DValue(A1) --------- 60
2.-- "5m x 20m" ---------------- =DValue(A2) --------- 100
3.-- "(2hàng+3hàng)*10người" -- =DValue(A3) --------- 50
4.-- "60người : 2 xe" ----------- =Dvalue(A4) ---------- 30

Phép tính nhân có thể là dấu * hoặc x
Phép tính chia có thể là dấu / hoặc :

Mã:
Public Function DValue(Expr)
    Char = Expr
    Sent = Space(0)
    ABC = "0123456789+-*/()." & Space(1)
    XYZ = "0123456789" & Space(1)
    For m = 2 To 3
        Met = "m" & m
        Temp = InStr(1, Char, Met)
        Do While Temp > 0
            If Temp > 0 Then
                Char = Left(Char, Temp) & Mid(Char, Temp + 2)
            End If
            Temp = InStr(1, Char, Met)
        Loop
    Next
    For i = 1 To Len(Char)
        KyTu = Mid(Char, i, 1)
        If InStr(1, ABC, KyTu) > 0 Then
            Sent = Sent & KyTu
        Else
            Select Case KyTu
                Case ":"
                    Left_ = Mid(Char, i - 1, 1)
                    Right_ = Mid(Char, i + 1, 1)
                    If InStr(1, XYZ, Right_) > 0 Then
                        Sent = Sent & "/"
                    End If
                Case ","
                    Sent = Sent & "."
                Case "%"
                    Sent = Sent & "/100"
                Case "x", "X"
                    Left_ = Mid(Char, i - 1, 1)
                    Right_ = Mid(Char, i + 1, 1)
                    If InStr(1, XYZ, Right_) > 0 Then
                        Sent = Sent & "*"
                    End If
            End Select
        End If
    Next
    DValue = Eval(Sent)
End Function
TDN
cảm ơn anh tedaynui đã chia xẻ code rất hay, em vừa có ý tưởng, gắn thêm diễn giải phần tính thì em có đoạn code ngắn gọn sau:
Mã:
 Function tt(Mystr As String, Optional Dautp As String) As Double
Dim i As Integer
Dim s As String
i = InStr(1, Mystr, ":")
s = Right(Mystr, Len(Mystr) - i)
tt = Evaluate("=" & s)     'lenh  tt = dien giai khoi luong: number +-*/ number
End Function

Ví dụ :
---------A---------------------------B---------------giá trị trả về
--- "tổng thu: 6*10+5/5" ---------=tt(A1) --------- 61


Hiện tại mình muốn kết hợp code DValue và code tt, có diễn giải trước khi ghi tính toán thì làm thế nào vậy, mong các bác giúp mình với

ví dụ ý mình:
---------A---------------------------B---------------giá trị trả về
--- "tổng thu: 6*10đ+5đ/5" ---------=tt(A1) --------- 61
 
có cách nào không vào tùy chỉnh mà vẫn mở được file đó không vậy?
 
anh lminhv hiểu rồi có thể chỉ rõ hơn được không
em cũng đã thử làm nhưng không ra được kết quả như trong file DValue2.xls đã tải ở trên
Cứ đánh cú pháp Dvalue(D6) vào là nó báo lỗi
#NAME?
 
Xin chào mọi người
Cho em hỏi nếu trong ô A1 có diễn giải: 10thanh*0.5m*4mặt*1m+0.5m*10m
Thì dùng công gì để ra kết quả ở ô B1 là: 25
Em xin chân thành cám ơn.
 
Excel 2010 bị lỗi ko chạy được đòi pass (Viet tool )
 
Lần chỉnh sửa cuối:
Code này phải như vầy:
PHP:
Public Function DValue(Expr)
    Char = Expr
    Sent = Space(0)
    ABC = "0123456789+-*/().^" & Space(1)
    XYZ = "0123456789" & Space(1)
    For m = 2 To 3
        Met = "m" & m
        Temp = InStr(1, Char, Met)
        Do While Temp > 0
            If Temp > 0 Then
                Char = Left(Char, Temp) & Mid(Char, Temp + 2)
            End If
            Temp = InStr(1, Char, Met)
        Loop
    Next
    For i = 1 To Len(Char)
        KyTu = Mid(Char, i, 1)
        If InStr(1, ABC, KyTu) > 0 Then
            Sent = Sent & KyTu
        Else
            Select Case KyTu
                Case ":"
                    Left_ = Mid(Char, i - 1, 1)
                    Right_ = Mid(Char, i + 1, 1)
                    If InStr(1, XYZ, Right_) > 0 Then
                        Sent = Sent & "/"
                    End If
                Case ","
                    Sent = Sent & "."
                Case "%"
                    Sent = Sent & "/100"
                Case "x", "X"
                    Left_ = Mid(Char, i - 1, 1)
                    Right_ = Mid(Char, i + 1, 1)
                    If InStr(1, XYZ, Right_) > 0 Then
                        Sent = Sent & "*"
                    End If
                Case "^"
                    Sent = Sent & "^"
            End Select
        End If
    Next
    DValue = Application.Evaluate(Sent)
End Function
Hoặc bạn Download lại với file DValue3.rar đi.
Mình thấy file này ổn hơn.
Thân.
code trên sẽ ra sai nếu trong cell gõ thế này "5 cây/m *7m/cây*8m"
 
Các ban ơi. Sao hàm Dvalue không đúng với số mủ và căn bậc hai: ví dụ 3^2=32; sqrt(4)=4
Các bạn có hàm nào khác mà vừa sử dụng cho biểu thức và hàm số mủ cho minh với
 
Mình đang làm khối lượng trong hệ ME và có các đoạn biểu thức ( 1,2 + 1,1 + 7,04 + 1,19 + 0,9 + 7,21 + 4,09 + 3,28 + 12,92 + 1,79 + 13,32 ), dùng Excel 2013.
Nhưng khi download DValue ở trên thì không tính được.
Mong các Pro chỉ giáo !
Xin chân thành cám ơn !
 
Mình đang làm khối lượng trong hệ ME và có các đoạn biểu thức ( 1,2 + 1,1 + 7,04 + 1,19 + 0,9 + 7,21 + 4,09 + 3,28 + 12,92 + 1,79 + 13,32 ), dùng Excel 2013.
Nhưng khi download DValue ở trên thì không tính được.
Mong các Pro chỉ giáo !
Xin chân thành cám ơn !
đúng ME của mình tính dây và ống rất nhiều, nếu k có hàm làm thay thì thủ công gãy hết cả tay bạn nhỉ. Tôi sd DValue vẫn đang bị lỗi kết quả #Name?
 
Các ban ơi. Sao hàm Dvalue không đúng với số mủ và căn bậc hai: ví dụ 3^2=32; sqrt(4)=4
Các bạn có hàm nào khác mà vừa sử dụng cho biểu thức và hàm số mủ cho minh với
Code ở #7 chạy hoàn toàn đúng với biểu thức 3^2 hay sqrt(4) của bạn nhập vào. Vì code sẽ hiểu 3^2 không phải là 3 bình phương=3*3 = 9
ps: Phải sửa code thì mới chạy cho trường hợp đơn cử như ^ hay sqrt
 
Mình loanh quanh có code này xài được, nhưng chỉ hiểu 3^2=9; với căn bậc hai Sqrt (4) thì vẫn đang hiểu sai là 4. Chắc bác nào sửa cái code Dvalue3.xla này giúp ae down về dùng với ạ
 

File đính kèm

  • DValue3.xla
    25 KB · Đọc: 96
Nhờ các bạn trợ giúp về Hàm Ct và Hàm Dvalue :
Mình là dân mới vào nghề, không biêt các dùng 2 hàm trên trong exel nhờ các bạn trợ giúp, cách dùng như thế nào ( mong được hướng dẫn cụ thể nhất)
 
Nhờ các bạn trợ giúp về Hàm Ct và Hàm Dvalue :
Mình là dân mới vào nghề, không biêt các dùng 2 hàm trên trong exel nhờ các bạn trợ giúp, cách dùng như thế nào ( mong được hướng dẫn cụ thể nhất)
Hàm Ct và Hàm Dvalue ở bài số mấy thế bạn?
Topic này có nhiều code, nhiều file đính kèm.
 
Nhờ mọi người giúp mình:
Phần diễn giải khối lượng của mình rất nhiều ký tự, nhưng hiện tại các Hàm Dvalue lại giới hạn 100 ký tự. vậy có cách nào không mọi người
 
Web KT

Bài viết mới nhất

Back
Top Bottom