Nhờ giúp viết code tính toán

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!

Nhờ giúp viết code tính toán

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

Đếm ngược thời gian