Nhờ giúp viết code tính toán (2 người xem)

ncq2003 · 4/8/16

Nhờ các bạn viết giùm code Visua basic để tính khối lượng trong cột B.
Qui ước chỉ tính từ sau dấu ":" trở về sau; Nếu trong biểu thức có text thì loại bỏ text. Nếu có khoảng trắng thì loại bỏ khoảng trắng.
[TABLE="width: 501"]
[TR]
[TD]Cộng là (+)[/TD]
[/TR]
[TR]
[TD]Trừ (-)[/TD]
[/TR]
[TR]
[TD]nhân (*)[/TD]
[/TR]
[TR]
[TD]Chia (/)
Các bạn viết giùm code để mình insert vào các file khác
Cám ơn các bạn đã quan tâm[/TD]
[/TR]
[/TABLE]

giangleloi · 4/8/16

ncq2003 đã viết:
Nhờ các bạn viết giùm code Visua basic để tính khối lượng trong cột B.
Qui ước chỉ tính từ sau dấu ":" trở về sau; Nếu trong biểu thức có text thì loại bỏ text. Nếu có khoảng trắng thì loại bỏ khoảng trắng.
[TABLE="width: 501"]
[TR]
[TD]Cộng là (+)[/TD]
[/TR]
[TR]
[TD]Trừ (-)[/TD]
[/TR]
[TR]
[TD]nhân (*)[/TD]
[/TR]
[TR]
[TD]Chia (/)
Các bạn viết giùm code để mình insert vào các file khác
Cám ơn các bạn đã quan tâm[/TD]
[/TR]
[/TABLE]

Thử tạm với code này xem sao:

Mã:

Sub Tinh_Toan()
Dim Arr, vlArr(1 To 10000, 1 To 1), I, Tam
Arr = Range([A2], [A65000].End(3)).Value
For I = 1 To UBound(Arr, 1)
 Tam = Arr(I, 1)
 If InStr(Trim(Tam), ":") < Len(Trim(Tam)) Then
  vlArr(I, 1) = Application.Evaluate("=" & Replace(Trim(Mid(Tam, _
  InStr(Tam, ": ") + 1, Len(Tam))), ",", "."))
 End If
Next
[B2].Resize(I) = vlArr
End Sub

befaint · 4/8/16

Thử cái này:

PHP:

Function Klg(cll As String)
cll = Replace(Application.Trim(Right(cll, Len(cll) - InStr(cll, ":"))), ",", ".")
If cll <> "" Then
Application.Volatile
Klg = Evaluate(cll)
End If
End Function

quanluu · 4/8/16

ncq2003 đã viết:
Nhờ các bạn viết giùm code Visua basic để tính khối lượng trong cột B.
Qui ước chỉ tính từ sau dấu ":" trở về sau; Nếu trong biểu thức có text thì loại bỏ text. Nếu có khoảng trắng thì loại bỏ khoảng trắng.
[TABLE="width: 501"]
[TR]
[TD]Cộng là (+)[/TD]
[/TR]
[TR]
[TD]Trừ (-)[/TD]
[/TR]
[TR]
[TD]nhân (*)[/TD]
[/TR]
[TR]
[TD]Chia (/)
Các bạn viết giùm code để mình insert vào các file khác
Cám ơn các bạn đã quan tâm[/TD]
[/TR]
[/TABLE]

Bài này làm thủ công ko cần code cũng đc nhé. Thủ công thì mất 3-4 bước
B1: copy cột A sang cột B
B2: Find and replace với :Find: *: và Replace: để trống
B3: 1 là dùng Evaluate, 2 là làm thêm dấu = đằng trc. Bạn có thể coi video này
[video=youtube;C5Bxh2bWroQ]https://www.youtube.com/watch?v=C5Bxh2bWroQ[/video]

giangleloi · 4/8/16

hpkhuong đã viết:
Máy người ta hổng fải vậy mà ngược dấu phân cách thì nàm thao anh đập choai???

Mã:

Replace(Trim(Mid(Tam, _ InStr(Tam, ": ") + 1, Len(Tam))), [SIZE=5][COLOR=#ff0000][B]",", ".")[/B][/COLOR][/SIZE]

Cái đó để người ta phản hồi đi. Còn tôi cố tình viết như vậy để ông bon chen vô mà. Lần nào cũng thế và lần nào cũng vậy. Mà hình như vấn đề đó cũng không ảnh hưởng cho lắm.

ncq2003 · 4/8/16

giangleloi đã viết:

Thử tạm với code này xem sao:

Mã:

Sub Tinh_Toan()
Dim Arr, vlArr(1 To 10000, 1 To 1), I, Tam
Arr = Range([A2], [A65000].End(3)).Value
For I = 1 To UBound(Arr, 1)
 Tam = Arr(I, 1)
 If InStr(Trim(Tam), ":") < Len(Trim(Tam)) Then
  vlArr(I, 1) = Application.Evaluate("=" & Replace(Trim(Mid(Tam, _
  InStr(Tam, ": ") + 1, Len(Tam))), ",", "."))
 End If
Next
[B2].Resize(I) = vlArr
End Sub

Code này sử dụng ko được bạn ơi
Lỗi thế này

ncq2003 · 4/8/16

befaint đã viết:
Thử cái này:

PHP:

Function Klg(cll As String) cll = Replace(Application.Trim(Right(cll, Len(cll) - InStr(cll, ":"))), ",", ".") If cll <> "" Then Application.Volatile Klg = Evaluate(cll) End If End Function

Vâng code này mình đang sử dụng được.
Có gì sẽ báo lại

giangleloi · 5/8/16

ncq2003 đã viết:
Code này sử dụng ko được bạn ơi
Lỗi thế nàyView attachment 163344 View attachment 163344

Code của mình là Sub không phải Function. Bạn phải chạy bằng cách bấm Alt + F8 chọn tên SUB và RUN. Hoặc xem file bấm vô Shapes có tên GPE.

ncq2003 · 6/8/16

befaint đã viết:
Thử cái này:

PHP:

Function Klg(cll As String) cll = Replace(Application.Trim(Right(cll, Len(cll) - InStr(cll, ":"))), ",", ".") If cll <> "" Then Application.Volatile Klg = Evaluate(cll) End If End Function

Hàm này còn 1 lỗi là nếu trong biểu thức có text thì nó sẽ báo lỗi Value.
Ví dụ : 100/2 = 50
Nhưng 100 m2/2 = Value
Nhờ bạn thêm giùm phần loại bỏ text trong biểu thức với (Nhất là các ký tự như m2, m3, Kg, Tấn ...)

quanluu · 6/8/16

ncq2003 đã viết:
Hàm này còn 1 lỗi là nếu trong biểu thức có text thì nó sẽ báo lỗi Value.
Ví dụ : 100/2 = 50
Nhưng 100 m2/2 = Value
Nhờ bạn thêm giùm phần loại bỏ text trong biểu thức với (Nhất là các ký tự như m2, m3, Kg, Tấn ...)

Bạn thử với code này

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")
For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 45, 47 To 58, 91, 93, 120, 123, 125
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i
strTemp = Replace(strTemp, ",", ".")
ValueEval = Evaluate(strTemp)


End Function

ncq2003 · 6/8/16

quanluu1989 đã viết:

Bạn thử với code này

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")
For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 45, 47 To 58, 91, 93, 120, 123, 125
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i
strTemp = Replace(strTemp, ",", ".")
ValueEval = Evaluate(strTemp)


End Function

Cám ơn bạn nhưng code này dùng hàm nào ạ

quanluu · 6/8/16

ncq2003 đã viết:
Cám ơn bạn nhưng code này dùng hàm nào ạ

Trời, đây là hàm tự tạo nên tên hàm chính là tên function: ValueEval.
A1 là dữ liệu thì B1 = ValueEval(A1)

befaint · 6/8/16

quanluu1989 đã viết:

Bạn thử với code này

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")
For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 45, 47 To 58, 91, 93, 120, 123, 125
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i
strTemp = Replace(strTemp, ",", ".")
ValueEval = Evaluate(strTemp)


End Function

Sao lại không case 46 và 94. Thử 10.4 m2/2 xem??
Còn 58, 91, 93, 120, 123, 125 làm chi?

quanluu · 6/8/16

befaint đã viết:
Sao lại không case 46 và 94. Thử 10.4 m2/2 xem??
Còn 58, 91, 93, 120, 123, 125 làm chi?

Cái này thì mình chỉ sủa function có sẵn cho phù hợp với bài của bạn ấy, nên sẽ có 1 số case thừa.

ncq2003 · 6/8/16

quanluu1989 đã viết:
Trời, đây là hàm tự tạo nên tên hàm chính là tên function: ValueEval.
A1 là dữ liệu thì B1 = ValueEval(A1)

Vâng, mình hiểu rồi, BẠn thông cảm mình không biết chút nào về Visua Basic cả
Nhưng giờ lại phát sinh thêm 1 yêu cầu nữa:
Nếu trong biểu thức có kiểu / (Ví dụ Kg/m3; T/m3, Cây/m2 ...) thì bị lỗi
Ví dụ : 1,65 T/m3*0,5m3 = Value
Mong bạn giúp khắc phục lỗi này giùm mình
Cám ơn các bạn nhiều

quanluu · 6/8/16

ncq2003 đã viết:
Vâng, mình hiểu rồi, BẠn thông cảm mình không biết chút nào về Visua Basic cả
Nhưng giờ lại phát sinh thêm 1 yêu cầu nữa:
Nếu trong biểu thức có kiểu / (Ví dụ Kg/m3; T/m3, Cây/m2 ...) thì bị lỗi
Ví dụ : 1,65 T/m3*0,5m3 = Value
Mong bạn giúp khắc phục lỗi này giùm mình
Cám ơn các bạn nhiều

Code thế này đã, nếu có thêm vấn đề thì fix tiếp

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")


For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 57
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i


strTemp = Replace(strTemp, ",", ".")
strTemp = Replace(strTemp, "/*", "*")
strTemp = Replace(strTemp, "/+", "+")
strTemp = Replace(strTemp, "/-", "-")
strTemp = Replace(strTemp, "//", "/")
ValueEval = Evaluate(strTemp)


End Function

ncq2003 · 6/8/16

quanluu1989 đã viết:

Code thế này đã, nếu có thêm vấn đề thì fix tiếp

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")


For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 57
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i


strTemp = Replace(strTemp, ",", ".")
strTemp = Replace(strTemp, "/*", "*")
ValueEval = Evaluate(strTemp)


End Function

Cám ơn bạn đã nhiệt tình giúp
Mong bạn giúp fix tiếp lỗi này (hy vọng lần cuối)
Lỗi lúc nãy đã khắc phục xong
Giờ thì đến vấn đề này
1,65 T/m3/0,5m3 = Value

quanluu · 6/8/16

ncq2003 đã viết:
Cám ơn bạn đã nhiệt tình giúp
Mong bạn giúp fix tiếp lỗi này (hy vọng lần cuối)
Lỗi lúc nãy đã khắc phục xong
Giờ thì đến vấn đề này
1,65 T/m3/0,5m3 = Value

Mình đã update code trên rùi. Bạn check lại nhé

ncq2003 · 6/8/16

quanluu1989 đã viết:
Mình đã update code trên rùi. Bạn check lại nhé

Cám ơn bạn Code đã hoạt động tốt }}}}}

ncq2003 · 7/8/16

quanluu1989 đã viết:
Mình đã update code trên rùi. Bạn check lại nhé

Lại làm phiền bạn thêm lần nữa
Lần này phát sinh lỗi như thế này

25 cây/m2 * 1,44m2 = 36
1,44 m *25 cây/m2 = #VALUE!

quanluu · 7/8/16

ncq2003 đã viết:
Lại làm phiền bạn thêm lần nữa
Lần này phát sinh lỗi như thế này

25 cây/m2 * 1,44m2 = 36
1,44 m *25 cây/m2 = #VALUE!

Bạn phải tự suy diẽ từ code ra chứ. Bạn thêm dòng này

strTemp = Replace(strTemp, "*/", "*")

ncq2003 · 7/8/16

quanluu1989 đã viết:
Bạn phải tự suy diẽ từ code ra chứ. Bạn thêm dòng này

strTemp = Replace(strTemp, "*/", "*")

Hic, mình thì không biết gì về code bạn ạ +-+-+-+

Mình thêm dòng đó vào nó vẫn y như vậy bạn.
Giúp mình thêm lần này nữa đi Cám ơn -=.,,

quanluu · 7/8/16

ncq2003 đã viết:
Hic, mình thì không biết gì về code bạn ạ

Mình thêm dòng đó vào nó vẫn y như vậy bạn.
Giúp mình thêm lần này nữa đi Cám ơn

Mình bị nhầm code trên. Chắc code này ổn

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")


For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 57
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i


strTemp = Replace(strTemp, ",", ".")
strTemp = Replace(strTemp, "/*", "*")
strTemp = Replace(strTemp, "/+", "+")
strTemp = Replace(strTemp, "/-", "-")
strTemp = Replace(strTemp, "//", "/")
If Not IsNumeric(Right(strTemp, 1)) Then strTemp = Left(strTemp, Len(strTemp) - 1)
ValueEval = Evaluate(strTemp)
End Function

ncq2003 · 7/8/16

Cám ơn bạn, chắc được rồi

ncq2003 · 9/8/16

quanluu1989 đã viết:

Mình bị nhầm code trên. Chắc code này ổn

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")


For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 57
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i


strTemp = Replace(strTemp, ",", ".")
strTemp = Replace(strTemp, "/*", "*")
strTemp = Replace(strTemp, "/+", "+")
strTemp = Replace(strTemp, "/-", "-")
strTemp = Replace(strTemp, "//", "/")
If Not IsNumeric(Right(strTemp, 1)) Then strTemp = Left(strTemp, Len(strTemp) - 1)
ValueEval = Evaluate(strTemp)
End Function

Bây giờ lại thêm lỗi này nữa bạn ạ :
14*((3,14*1,2*1,2/4) - (3,14*1*1/4)) = #VALUE
Theo mình dò từ từ thì Nếu biểu thức có nhiều hơn 1 cặp dấu "()" công thức sẽ báo lỗi
Mong bạn giúp giùm, mình dò theo code của bạn mà tại không biết về Visua Basic nên chả hiểu gì hết.
Cám ơn bạn nhiều

quanluu · 9/8/16

ncq2003 đã viết:
Bây giờ lại thêm lỗi này nữa bạn ạ :
14*((3,14*1,2*1,2/4) - (3,14*1*1/4)) = #VALUE
Theo mình dò từ từ thì Nếu biểu thức có nhiều hơn 1 cặp dấu "()" công thức sẽ báo lỗi
Mong bạn giúp giùm, mình dò theo code của bạn mà tại không biết về Visua Basic nên chả hiểu gì hết.
Cám ơn bạn nhiều

Hic, vậy thì đổi lại vậy

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")


For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 57
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i


strTemp = Replace(strTemp, ",", ".")
strTemp = Replace(strTemp, "/*", "*")
strTemp = Replace(strTemp, "/+", "+")
strTemp = Replace(strTemp, "/-", "-")
strTemp = Replace(strTemp, "//", "/")
If Right(strTemp, 1) = "/" Then strTemp = Left(strTemp, Len(strTemp) - 1)
ValueEval = Evaluate(strTemp)
End Function

ncq2003 · 9/8/16

Cám ơn bạn, code đã chạy dược

ncq2003 · 11/8/16

quanluu1989 đã viết:

Hic, vậy thì đổi lại vậy

Mã:

Function ValueEval(rng As String)
Dim i As Integer
Dim strTemp As String
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")


For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 57
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i


strTemp = Replace(strTemp, ",", ".")
strTemp = Replace(strTemp, "/*", "*")
strTemp = Replace(strTemp, "/+", "+")
strTemp = Replace(strTemp, "/-", "-")
strTemp = Replace(strTemp, "//", "/")
If Right(strTemp, 1) = "/" Then strTemp = Left(strTemp, Len(strTemp) - 1)
ValueEval = Evaluate(strTemp)
End Function

Mong bạn giúp giùm mình thêm đoạn code nữa để tính số mũ ví dụ : 15^2
- Đoạn code trên nếu để 15^2 sẽ ra 152
Cám ơn bạn nhiều

quanluu · 11/8/16

ncq2003 đã viết:
Mong bạn giúp giùm mình thêm đoạn code nữa để tính số mũ ví dụ : 15^2
- Đoạn code trên nếu để 15^2 sẽ ra 152
Cám ơn bạn nhiều

thêm 94 trong case nữa: Case 40 To 57 thành Case 40 To 57, 94

ncq2003 · 16/8/16

quanluu1989 đã viết:
thêm 94 trong case nữa: Case 40 To 57 thành Case 40 To 57, 94

[Mong bạn giúp mình thêm đoạn Thay chữ x bằng dấu * trong biểu thức tính toán với
Cám ơn, mình làm được rồi

ncq2003 · 29/9/16

quanluu1989 đã viết:
thêm 94 trong case nữa: Case 40 To 57 thành Case 40 To 57, 94

Cám ơn bạn đã nhiệt tình giúp mình.
Đoạn code chạy rất tốt cho công việc của mình.
Nay mình nhờ bạn giúp mình thêm chút nữa nhé :
Mình muốn thay số mũ như 2[SUP]2[/SUP] = 2^2 ( Nghĩa là 2 bình phương ) thì thêm như thế nào bạn.
(Có một số người thích để chỉ số trên cho đẹp, mà mình sửa như thế trong một file dự toán thì lâu quá)
Cám ơn bạn trước.

ncq2003 · 29/9/16

Giúp mình với quanluu1989 ơi

quanluu · 30/9/16

ncq2003 đã viết:
Giúp mình với quanluu1989 ơi

Bạn thử thế này coi

Mã:

Function ValueEval(cel As Range)
Dim i As Integer
Dim strTemp As String, rng As String
For i = 1 To Len(cel.Value)
    If cel.Characters(i, 1).Font.Superscript Then
        rng = rng & "^" & Mid(cel.Value, i, 1)
    Else
        rng = rng & Mid(cel.Value, i, 1)
    End If
Next
rng = Application.Trim(Right(rng, Len(rng) - InStr(rng, ":")))
rng = Replace(rng, "m2", "")
rng = Replace(rng, "m3", "")


For i = 1 To Len(rng)
    Select Case Asc(Mid(rng, i, 1))
    Case 40 To 57, 94
        strTemp = strTemp & Mid(rng, i, 1)
    End Select
Next i


strTemp = Replace(strTemp, ",", ".")
strTemp = Replace(strTemp, "/*", "*")
strTemp = Replace(strTemp, "/+", "+")
strTemp = Replace(strTemp, "/-", "-")
strTemp = Replace(strTemp, "//", "/")
If Right(strTemp, 1) = "/" Then strTemp = Left(strTemp, Len(strTemp) - 1)
MsgBox (strTemp)
ValueEval = Evaluate(strTemp)
End Function

lan070907 · 23/11/16

nếu có hàm round trong công thức thì làm thế nào hả anh?
Xin chân thành cảm ơn, em mò mấy bữa rồi mà chưa ra

ncq2003 · 23/11/16

lan070907 đã viết:
nếu có hàm round trong công thức thì làm thế nào hả anh?
Xin chân thành cảm ơn, em mò mấy bữa rồi mà chưa ra

Mình chưa bị
Bạn quanluu1989 ơi giúp với

Vinh TN · 21/1/19

ncq2003 đã viết:
Mình chưa bị
Bạn quanluu1989 ơi giúp với

Bạn bị thế này chưa: 9*3^2= 288

Nhờ giúp viết code tính toán (2 người xem)

Người dùng đang xem chủ đề này

Thành viên chính thức

File đính kèm

Thành viên gắn bó

|||||||||||||

Thành viên gắn bó

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

Thành viên gắn bó

File đính kèm

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

|||||||||||||

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên chính thức

Thành viên chính thức

Thành viên gắn bó

Thành viên mới

Thành viên chính thức

Thành viên mới

Thời gian đếm ngược.