vanle33
Thành viên gạo cội




- Tham gia
- 30/10/08
- Bài viết
- 5,962
- Được thích
- 4,009
- Giới tính
- Nam
Cho mình hỏi luôn cách để kết quảSửa đoạn code này là xong thôi: Target = Replace(Cll, ".", ",") & " = " & Tinh
On Error Resume Next
Mình hoàn toàn không biết chỉnh sửa code. Bạn sửa cho mình nhé.Tôi thấy bạn chỉ cần xử lý chuỗi là được
- Kết quả ban đầu dạng: 123456.89
- Kết quả mong muốn : 123,456.89
=> Công việc bạn cần làm là:
Bước 1: Format dãy số đó dạng 123,456.89 => Tức là có dấu phân cách phần nghìn => Bạn record macro fomat cell là có
Bước 2: Thay thế dấu chấm "." bằng 1 ký tự đặc biệt (ví dụ @ sẽ được 123,456@89)
Bước 3: Thay thế dấu phảy "," bằng dấu chấm (ví dụ @ sẽ được 123.456@89)
Bước 3: Thay thế dấu @ bằng dấu phảy
Khi bạn không muốn báo lỗi thì bạn cho dòng lệnh sau dưới dòng Sub...
Mã:On Error Resume Next
Bạn làm từng bước như sau:Mình hoàn toàn không biết chỉnh sửa code. Bạn sửa cho mình nhé.
Mình thử thêm dòng chữ On Error Resume Next
thì báo lỗi
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Cll, Tach, Tinh
If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
If Target.Count = 1 Then
Cll = Replace(Target, ",", ".")
If InStr(Cll, "=") = 0 Then
Tach = Split(Cll, ":")
Tinh = Evaluate(Trim(Tach(1)))
'B1
Tinh = Format(Tinh, "#,##0.00")
'B2
Tinh = Replace(Tinh, ".", "@")
'B3
Tinh = Replace(Tinh, ",", ".")
'B4
Tinh = Replace(Tinh, "@", ",")
'------------
Target = Cll & " = " & Tinh
End If
End If
End If
End Sub
Cám ơn bạnBạn làm từng bước như sau:
Mã:Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim Cll, Tach, Tinh If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then If Target.Count = 1 Then Cll = Replace(Target, ",", ".") If InStr(Cll, "=") = 0 Then Tach = Split(Cll, ":") Tinh = Evaluate(Trim(Tach(1))) 'B1 Tinh = Format(Tinh, "#,##0.00") 'B2 Tinh = Replace(Tinh, ".", "@") 'B3 Tinh = Replace(Tinh, ",", ".") 'B4 Tinh = Replace(Tinh, "@", ",") '------------ Target = Cll & " = " & Tinh End If End If End If End Sub
Tóm lại bạn muốn phân cách phần nghìn là ở chỗ nào? Phần màu đỏ hay phần màu tím?Cho mình hỏi luôn cách để kết quả
+) Ra 3 số sau dấu phảy
+) Và có dấu phân cách hàng nghìn trong kết quả
Ví dụ như thế này : 2.130,894
Phần màu đỏ đó bạnTóm lại bạn muốn phân cách phần nghìn là ở chỗ nào? Phần màu đỏ hay phần màu tím?
Thực ra bạn có thể làm được nếu vận dụng uyển chuyển Replace hoặc các hàm liên quan tới tách thập phân....
Tôi không biết trên máy của bạn thì kết quả như thế nào, còn trên máy của tôi thì kết quả như bạn mong muốn về việc thay đổi cái dấu đó.Phần màu đỏ đó bạn
Có thể bạn không làm trong lĩnh vực xây dựng nên bạn không hiểu con số 2.130,894
Đó là quy định trong nghành của mình để tính toán khối lượng, chạy phần mềm dự toán.
Mình thấy đó là quy định thông dụng cho Việt Nam mà. Còn nếu là hệ thống của nước ngoài thì con số trên của mình sẽ là 2,130.894
Máy mình ra kết quả như bài #8 đó.Tôi không biết trên máy của bạn thì kết quả như thế nào, còn trên máy của tôi thì kết quả như bạn mong muốn về việc thay đổi cái dấu đó.
Tôi không biết trên máy của bạn thì kết quả như thế nào, còn trên máy của tôi thì kết quả như bạn mong muốn về việc thay đổi cái dấu đó.
1) Mình thấy code của bạn chạy hơi chậm so với code trong file #1.Quy định phân cách VN với nước ngoài ngược nhau bạn phải hiểu bản chất nó trong file yêu cầu định dạng kểu VN mà nhập nhân chia trừ cộng lại theo nước ngoài 0.5 nếu đúng ở VN là 0,5, 9.2 đáng lẽ là 9,2 nói chung là không theo chuẩn của quy ước số VN
[GPECODE=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, y, z
With Application
x = .UseSystemSeparators
y = .DecimalSeparator
z = .ThousandsSeparator
End With
With Application
.UseSystemSeparators = False
.DecimalSeparator = ","
.ThousandsSeparator = "."
End With
Dim Cll, Tach, Tinh
If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
If Target.Count = 1 Then
Cll = Replace(Target, ",", ".")
If InStr(Cll, "=") = 0 Then
Tach = Split(Cll, ":")
With Target.Offset(, 1)
.NumberFormat = "#,##0.0"
.Value = Evaluate(Trim(Tach(1)))
Target = Cll & " = " & Trim(.Text)
.ClearContents
End With
End If
End If
End If
With Application
.UseSystemSeparators = x
.DecimalSeparator = y
.ThousandsSeparator = z
End With
End Sub
[/GPECODE]
Bạn thử code trên xem sao đính kèm file
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cLL As String, Tinh As String
If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
If Target.Count = 1 And Target.Value <> "" _
And Right(Target, 1) = "=" And InStr(Target, ":") > 0 Then
On Error GoTo HandlError
Application.EnableEvents = False
cLL = Left(Target, Len(Target) - 1)
cLL = Replace(cLL, ",", ".")
Tinh = Trim(Split(cLL, ":")(1))
Tinh = Format(Evaluate(Tinh), "#,##0.0##")
Tinh = Replace(Tinh, ".", "@") 'B2
Tinh = Replace(Tinh, ",", ".") 'B3
Tinh = Replace(Tinh, "@", ",") 'B4
'------------
Target = Replace(cLL, ".", ",") & " = " & Tinh
HandlError: Application.EnableEvents = True
End If
End If
End Sub
1) Phần kết qủa vẫn chưa ra dạng 2.130,89 mà vẫn ra 2,130.894Dùng code sau đi vậy,
Lưu ý
+ phái gõ dấu bằng (=) cuối cùng rui Enter thì mới có kết quả,
+ Chỉ tính toán khi ô đó có chứa dấu ":" và dấu = ở cuối cùng
+ Trong phần diễn giải chỉ gõ phần phân cách dấu thập phân - không gõ phần phân cách hàng nghìn
PHP:Private Sub Worksheet_Change(ByVal Target As Range) Dim cLL As String, Tinh As String If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then If Target.Count = 1 And Target.Value <> "" _ And Right(Target, 1) = "=" And InStr(Target, ":") > 0 Then On Error GoTo HandlError Application.EnableEvents = False cLL = Left(Target, Len(Target) - 1) cLL = Replace(cLL, ",", ".") Tinh = Trim(Split(cLL, ":")(1)) Tinh = Format(Evaluate(Tinh), "#,##0.0##") Tinh = Replace(Tinh, ".", "@") 'B2 Tinh = Replace(Tinh, ",", ".") 'B3 Tinh = Replace(Tinh, "@", ",") 'B4 '------------ Target = Replace(cLL, ".", ",") & " = " & Tinh HandlError: Application.EnableEvents = True End If End If End Sub
1) Phần kết qủa vẫn chưa ra dạng 2.130,89 mà vẫn ra 2,130.894
2) Bạn có thể chỉnh code để không phải nhấn dấu = mà chỉ Enter là ra kết quả không?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cLL As String, Tinh As String
If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
If Target.Count = 1 And Target.Value <> "" _
And InStr(Target, ":") > 0 Then
On Error GoTo HandlError
Application.EnableEvents = False
cLL = Trim(Target)
cLL = Replace(cLL, ",", ".")
Tinh = Trim(Split(cLL, ":")(1))
Tinh = Format(Evaluate(Tinh), "#,##0.000")
Tinh = Replace(Tinh, ".", "@") 'B2
Tinh = Replace(Tinh, ",", ".") 'B3
Tinh = Replace(Tinh, "@", ",") 'B4
'------------
Target = Replace(cLL, ".", ",") & " = " & Tinh
HandlError: Application.EnableEvents = True
End If
End If
End Sub
Mình nhập vào M3 : 2*4,6*67*3,457 nhấn Enter thì mình muốn ra kết quả là M3 : 2*4,6*67*3,457 = 2.130,895kết quả của dòng nào, bạn nói vô phương vậy
vậy thế này đi
PHP:Private Sub Worksheet_Change(ByVal Target As Range) Dim cLL As String, Tinh As String If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then If Target.Count = 1 And Target.Value <> "" _ And InStr(Target, ":") > 0 Then On Error GoTo HandlError Application.EnableEvents = False cLL = Trim(Target) cLL = Replace(cLL, ",", ".") Tinh = Trim(Split(cLL, ":")(1)) Tinh = Format(Evaluate(Tinh), "#,##0.000") Tinh = Replace(Tinh, ".", "@") 'B2 Tinh = Replace(Tinh, ",", ".") 'B3 Tinh = Replace(Tinh, "@", ",") 'B4 '------------ Target = Replace(cLL, ".", ",") & " = " & Tinh HandlError: Application.EnableEvents = True End If End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
If Target.Count = 1 And Target.Value <> "" _
And InStr(Target, ":") > 0 Then
On Error GoTo HandlError
Application.EnableEvents = False
Dim cLL As String, Tinh As String
cLL = Trim(Target)
cLL = Replace(cLL, ",", ".")
Tinh = Trim(Split(cLL, ":")(1))
Tinh = Format(Evaluate(Tinh), "#k###k###k###k###k##0.000")
Do While Left(Tinh, 1) = "k" Or Left(Tinh, 2) = "-k"
If Left(Tinh, 1) = "k" Then
Tinh = Right(Tinh, Len(Tinh) - 1)
Else
Tinh = "-" & Right(Tinh, Len(Tinh) - 2)
End If
Loop
Tinh = Replace(Tinh, ".", ",")
Tinh = Replace(Tinh, "k", ".")
Target = Replace(cLL, ".", ",") & " = " & Tinh
HandlError: Application.EnableEvents = True
End If
End If
End Sub
1) Mình thấy code của bạn chạy hơi chậm so với code trong file #1.
2) Mình thử với dòng này M3 : 38*83.564*89
sau khi nhấn Enter thì ra kêt quả 282.613,4
Mình muốn sau khi Enter thì cell đó sẽ là M3 : 38*83,564*89 = 282.613,448
Nghĩa là kết quả có
+) dấu phân cách hàng nghìn, hàng triệu là dấu chấm
+) dấu phân cách hàng thập phân là dấu phảy
+) Có 3 chữ số sau dấu phảy
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 Worksheet_Change(ByVal Target As Range)
Dim expression As String
If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
If Target.Count = 1 Then
If Target.Value <> "" And InStr(Target, ":") > 0 Then
expression = Trim(Split(Target.Value, ":")(1))
Application.EnableEvents = False
On Error GoTo end_
Target.Value = Trim(Target.Value) & " = " & FormatWithComma(Evaluate(expression))
End If
End If
End If
end_:
Application.EnableEvents = True
End Sub
1. OK --> kết quả hiển thị là OKBạn thử kiểm tra xem
------------
Trong diễn giải:
1. Phải có ký tự ":". Sau ký tự ":" là biểu thức.
2. Chỉ dùng dấu chấm "." làm dấu thập phân
1. OK --> kết quả hiển thị là OK
2. Bác chỉnh code cho em để em nhập dấu phân cách hàng thập phân là dấu phảy "," vì trên em hay nhập số diễn giải có phần phân cách hàng thập phân là dấu phảy "," Sau khi enter để chạy code thì dấu phảy "," này vẫn giữ nguyên không đổi thành dấu chấm "."
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 Worksheet_Change(ByVal Target As Range)
Dim expression As String
If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
If Target.Count = 1 Then
If Target.Value <> "" And InStr(Target, ":") > 0 Then
expression = Trim(Split(Target.Value, ":")(1))
[COLOR=#ff0000]expression = Replace(expression, ",", ".")[/COLOR]
Application.EnableEvents = False
On Error GoTo end_
Target.Value = Trim(Target.Value) & " = " & FormatWithComma(Evaluate(expression))
End If
End If
End If
end_:
Application.EnableEvents = True
End Sub
to bác sitow
Chuẩn rồi bác ạ
Em cám ơn bác nhiều! Sau này sử dụng nếu có phát sinh vấn đề gì mới em sẽ post lên topic này.
Bác sửa Code này để biểu thức không có dấu hai chấm ":" thì vẫn chạy được cho em với.Mã: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 Worksheet_Change(ByVal Target As Range) Dim expression As String If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then If Target.Count = 1 Then If Target.Value <> "" And InStr(Target, ":") > 0 Then expression = Trim(Split(Target.Value, ":")(1)) [COLOR=#ff0000]expression = Replace(expression, ",", ".")[/COLOR] Application.EnableEvents = False On Error GoTo end_ Target.Value = Trim(Target.Value) & " = " & FormatWithComma(Evaluate(expression)) End If End If End If end_: Application.EnableEvents = True End Sub
Chỗ đỏ đỏ là mới thêm vào. Bạn test thử xem
Nhưng em không thể nhập mã hiệu Đơn giá cho dù đã làm theo đúng hướng dẫn trong sheet "Help".Bạn vào đây: http://www.mediafire.com/download/ey0ipc3zs85pnf6/Setup_DutoanTC.exe
Cài xong xem trong file mẫu 01, Sheets 'khoi luong', Pass VBA: 6291412
(Chương trình dự toán của mình tự lập cho mình, chỉ dùng trong tỉnh mình)
Hic, ai biểu bạn khởi động chương trình làm gì, bạn chỉ cần mở Filemau01 thôi, nhập biểu thưc vào cột D, nếu thấy đúng ý thì xem code.Nhưng em không thể nhập mã hiệu Đơn giá cho dù đã làm theo đúng hướng dẫn trong sheet "Help".
Xem code trong sheet "khoi luong" thì cũng không được, chỉ nháy nháy rồi biến mất cửa sổ VBA.
Bác sửa Code này để biểu thức không có dấu hai chấm ":" thì vẫn chạy được cho em với.
Vì có trường hợp không có dấu hai chấm ":" trước biểu thức tính toán.
(49,2-4,2+0,5)*1,0*0,9*1,3*100
(49.2-4.2+0.5)*1.0*0.9*1.3*100=5 323.500
Xây tường trục A : (12-4)*0,22*3,6
Trát tường : 24*35*323
Dầm D3 : 23*0.22*0.6
M2(trụcA): (49.2-4.2+0.5)*1.0*0.9*1.3
S4 : 2.5*8.432*32
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 Worksheet_Change(ByVal Target As Range)
Dim expression As String
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_
Target.Value = Trim(Target.Value) & " = " & FormatWithComma(Evaluate(expression))
End If
End If
End If
end_:
Application.EnableEvents = True
End Sub
to bác siwtom
Em muốn dùng code của bác. Dùng file của bác thanhlanh em thấy code khá phức tạp (em đoán vậy hihi)
Code ở bài #30 đã đúng ý em
Có vấn đề này bác chỉnh code cho em 1 tý
Để sau khi nhấn Enter thì sẽ ra kết quả ở tại cột A1 và đồng thời xuất hiện kết quả tại B1 hoặc C1 (em có thể chỉnh sửa vị trí xuất hiện kết quả này). Mục đích của việc này để em tính tổng các khối lượng của cùng 1 đầu việc mà.
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 Worksheet_Change(ByVal Target As Range)
Dim expression As String, result
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 = FormatWithComma(Evaluate(expression))
Target.Value = Trim(Target.Value) & " = " & result
Target.Offset(, [B][COLOR=#ff0000]1[/COLOR][/B]).Value = result
End If
End If
End If
end_:
Application.EnableEvents = True
End Sub
Qua quá trình sử dụng thì mới phát sinh vấn đề mà bác.Sao lại có chuyện yêu cầu nhỏ giọt thế này? Thành viên có 2,243 bài mà còn thế sao?
Ta gõ biểu thức trong ô cột A --> ENTER --> cũng trong ô vừa gõ chuyển thành "biểu thức = kết quả" đồng thời ô cùng dòng ở cột B chỉ có "kết quả" không có "biểu thức = "???????
Nếu thế thì
Mã: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 Worksheet_Change(ByVal Target As Range) Dim expression As String, result 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 = FormatWithComma(Evaluate(expression)) Target.Value = Trim(Target.Value) & " = " & result Target.Offset(, [B][COLOR=#ff0000]1[/COLOR][/B]).Value = result End If End If End If end_: Application.EnableEvents = True End Sub
Nếu "kết quả" sang ô bên cạnh (B) thì để 1, sang ô bên cạnh nữa (C) thì sửa thành 2, nữa (D) thì sửa thành 3. Chỗ đỏ đỏ ấy.
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 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)
End If
End If
End If
end_:
Application.EnableEvents = True
End Sub
Cám ơn bácThì yêu cầu của bạn quái gở nên nó thế thôi.
Chính ra muốn là số thì phải theo CP. Đằng này bạn bắt kết quả phải có dấu thập phân là dấu phẩy, bất chấp trong CP thế nào, vậy khi trong CP bạn thiết lập dấu chấm "." là dấu thập phân thì rõ ràng kết quả 144.842,006 và 7.836,48 không là số thì đúng rồi.
Bạn hãy định nghĩa lại dạng kết quả ở cột A và B thì mới chiều được
Hay quá thì Cảm ơn mình và bác siwtom thật nhiệt tình cho tất cả các bài của topic này điBài này hay quá thầy SwisTom ơi, trước giờ em toàn dùng code và hàm evalua trên diễn đàn, nay có bài này thì tốt quá. Thầy cho em hỏi muốn các chuổi sao khi enter thành số và tính tổng như trong file đính kèm thì sửa code thế nào vậy thầy.
Hay quá thì Cảm ơn mình và bác siwtom thật nhiệt tình cho tất cả các bài của topic này đi
File của bạn tương tự file của mình nhưng bạn phải xóa dấu + ở đầu các mục diễn giải đi mới code mới chạy được.
Hay thì em like mà bácHay quá thì Cảm ơn mình và bác siwtom thật nhiệt tình cho tất cả các bài của topic này đi
File của bạn tương tự file của mình nhưng bạn phải xóa dấu + ở đầu các mục diễn giải đi mới code mới chạy được.
Bác quá bộ đến nhà em. Hai anh em mình nhậu lai rai. Em có rượu táo mèo Yên Bái mời bác.Bạn cứ giả vờ không biết vụ ken và mồi nhậu hả?
Bạn thử code ở #34 đi. Mình chạy thấy OKHay thì em like mà bác. Bác xem file em up lên để hỏi chưa? vì cái mình cần sum là sum ở cột A luôn. Mà chuỗi diễn giải này hình như còn ở dạng Text. Thầy SwisTom xem giùm em vấn đề này với
Nghĩa là bạn không muốn hiện Kết quả ở cột B hay cột C mà SUM lên luôn?Nếu em theo bài 34 thì cũng phải dùng công đoạn tô màu chữ trắng và sum lại. Nhưng điều em hỏi ở đây là nếu chuyển chuỗi thành số và sum như file em đính kèm thì code sẽ như thế nào? 1 công việc nào đó (ví dụ như gia công cốt thép D>18) thì trong đó gồm nhiều thành phần làm những công việc đó như Tường, móng .. (cái này bác dân xây dựng nên bít chắc mà). Mong bác Tom giúp em bài 36![]()
Chính xác là thế bác ạ, đành chờ lúc nào đó thầy Tom rãnh rỗi làm giúp vậyNghĩa là bạn không muốn hiện Kết quả ở cột B hay cột C mà SUM lên luôn?
Chỉnh code để không hiện kết quả ở đó mà SUM thẳng lên C12, C16 thì phải có bác Siwtom ra tay.
Chính xác là thế bác ạ, đành chờ lúc nào đó thầy Tom rãnh rỗi làm giúp vậy![]()
=SUM(--MID(A13:A15;FIND("=";A13:A15)+1;LEN(A13:A15)))
=[B][COLOR=#0000ff]MySumRange[/COLOR][/B](A13:A15)
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)
' [B][COLOR=#ff0000]Target.Offset(, 1).Value = result[/COLOR][/B]
Target.Value = Trim(Target.Value) & " = " & FormatWithComma(result)
End If
End If
End If
end_:
Application.EnableEvents = True
End Sub
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
Function [B][COLOR=#0000ff]MySumRange[/COLOR][/B](rng As Range) As Double
Dim cell As Range, pos As Long, text As String, result As Double
For Each cell In rng
text = cell.Value
pos = InStr(1, text, "=")
If pos > 0 Then result = result + Trim(Mid(text, pos + 1))
Next
MySumRange = result
End Function
Ý em là dạng chuỗi đó sau khi diễn giải và enter sẽ thành Value. Như file ví dụ em đưa lên, khi em gõ + Tường: 5*10*3*0,5 = 75 thì kết qua 75 này là dạng value chứ không phải dạng text, và code có thể sum như tính toán trong file ví dụ em đưa lên.Ý bạn là bạn gõ vd. vào A13 text + Tường: 5*10*3*0,5 thì sau khi Enter thì trong A13 tự chuyển thành
+ Tường: 5*10*3*0,5 = 75,0?
Nếu thế thì A13 nó là text chứ có là số đâu mà bạn SUM được kiểu SUM(A13:A15)?
Bạn phải nhập công thức cho C12
Mã:=SUM(--MID(A13:A15;FIND("=";A13:A15)+1;LEN(A13:A15)))
Kết thúc bằng Ctrl + Shift + Enter
hoặc công thức cho ô C12
Mã:=[B][COLOR=#0000ff]MySumRange[/COLOR][/B](A13:A15)
code sheet1
Mã: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) ' [B][COLOR=#ff0000]Target.Offset(, 1).Value = result[/COLOR][/B] Target.Value = Trim(Target.Value) & " = " & FormatWithComma(result) End If End If End If end_: Application.EnableEvents = True End Sub
module1
Mã: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 Function [B][COLOR=#0000ff]MySumRange[/COLOR][/B](rng As Range) As Double Dim cell As Range, pos As Long, text As String, result As Double For Each cell In rng text = cell.Value pos = InStr(1, text, "=") If pos > 0 Then result = result + Trim(Mid(text, pos + 1)) Next MySumRange = result End Function
Nếu bạn không muốn hiện kết quả của mỗi biểu thức ở cột bên cạnh thì xóa dòng đỏ đỏ
Càng giải thích càng rối. Làm y chang theo file ví dụ của bạn vậy.Ý em là dạng chuỗi đó sau khi diễn giải và enter sẽ thành Value. Như file ví dụ em đưa lên, khi em gõ + Tường: 5*10*3*0,5 = 75 thì kết qua 75 này là dạng value chứ không phải dạng text, và code có thể sum như tính toán trong file ví dụ em đưa lên.
Ý em là dạng chuỗi đó sau khi diễn giải và enter sẽ thành Value. Như file ví dụ em đưa lên, khi em gõ + Tường: 5*10*3*0,5 = 75 thì kết qua 75 này là dạng value chứ không phải dạng text, và code có thể sum như tính toán trong file ví dụ em đưa lên.
Bạn chỉ gõ + Tường: 5*10*3*0,5 còn = 75 là code thêm vào chứ bạn có gõ đâu mà nóikhi em gõ + Tường: 5*10*3*0,5 = 75 thì kết qua 75 ...
Trình bầy cẩu thả thế thì rất mệt cho người khác.khi em gõ + Tường: 5*10*3*0,5 = 75 ...
Dạ cái đoạn = 75 là code thêm code thêm vào. Em chỉ diễn giải ở kích thước, còn kết quả là code thêm vào. Nhưng ý em là mún phần diễn giải đó sau khi enter sẽ là giá trị chứ không phải text. Thầy thông cảm, hic phần thuyết trình diễn giải của em kém quá làm thầy ko hiểu và mệt hơnBạn suy nghĩ kỹ chưa?
Nếu bạn gõ vào A1 + Tường: 5*10*3*0,5 rồi Enter thì A1 trở thành 75?
Thế nếu bạn gõ nhầm thì làm sao bạn biết, đồng nghiệp, sếp biết bạn đã gõ gì? Và 75 kia nó là tiền công quốc đất hay đổ bê tông hay trát tường?
Mà kiểu giải thích của bạn cẩu thả quá.
Bạn viết
Bạn chỉ gõ + Tường: 5*10*3*0,5 còn = 75 là code thêm vào chứ bạn có gõ đâu mà nói
Trình bầy cẩu thả thế thì rất mệt cho người khác.
Chỉ có thầy BaTe là hiểu ý em nhỉ,
chuỗi đó sau khi diễn giải và enter sẽ thành Value
Dạ sory thầy vì phần diễn giải của em kém quá nên làm thầy và mọi người không hiểu. Nếu nói đúng thì là: Phần diễn giải khối lượng đó sau khi kết thúc sẽ thành value). Còn phần tự auto sum thì tốt hơn thay vì phải nhấn button. Cảm ơn vì lời thầy nhắc nhởChỉ có điều bạn nói:
sẽ thành có nghĩa là chuỗi biến mất và thay bào đó là Value. Tôi sẽ thành hổ có nghĩa là tôi không còn nữa mà thay vào đó là trên ghế có con hổ ngồi.
Mà bạn nói "và enter" chứ không nói "và nhấn Button".
Bạn có hiểu tôi viết gì không?
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
Chỉ cần chú thích lên Sheet quy định bắt buộc gõ thập phân dấu gì, phân cách hàng hàng dấu gì sau text là dấu gì cho khỏe gõ lung tung ai biết đường đâu mà lần(lớn rồi không biết quy định số của Việt Nam đi xuống lớp 1 học lại đi ke...ke..)
Mình nhớ là không có trích lại chắc bị lỗi gì rồi bây giờ mình mới vào mới thấy, có gì bạn đừng hiểu lầm nhený bạn là sao?
Thấy trích bài tôi viết lại, bạn lại viết vậy là có ý gì, liên quan lớp 1 gì đây???
File nay hay đó chỉ có điều là fonts chữ lại dùng VNI-Times nên không chuẩn fontsBạn vào đây: http://thanhcongstored.blogspot.com/
Cài xong xem trong file mẫu 01, Sheets 'khoi luong', Pass VBA: 6291412
(Chương trình dự toán của mình tự lập cho mình, chỉ dùng trong tỉnh mình)
Bạn ơi bạn có thể sửa code trên để dấu bằng và số kết quả tính có màu đỏ y trang như phần mềm dự toán được không.Sao làm dự toán mà lười quá gõ sum vào là xong mà cũng lười biếng, lười thế này thế nhầm lẫn lém, lại ra thêm cây cầu thiếu trọng tải thì nguy, hihihii (vui chút cho các bạn cẩn trọng)
Muốn lười thì
Copy hết vào sheet code là được (sửa và thêm vào code của bác Siwtom trên)
PHP: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
Bạn nên tạo Topic mới với tiêu đề rõ ràng, đính kèm file ví dụ, có kết quả mẫu mong muốn.các anh chị cho em hỏi công thức tính tổng của bảng diễn giải khối lượng sau trong excel
ví dụ ở cột diễn giải =2+2+4 thì em muốn cột tính tổng ra kết quả luôn là 9
em vẫn đang làm thủ công copy xong em đặt dấu = sau đó pates
xin anh chị hướng dẫn cụ thể vì em mù tịt không biết cái này
em xin chân thành cảm ơn
Bài này hay quá thầy SwisTom ơi, trước giờ em toàn dùng code và hàm evalua trên diễn đàn, nay có bài này thì tốt quá. Thầy cho em hỏi muốn các chuổi sao khi enter thành số và tính tổng như trong file đính kèm thì sửa code thế nào vậy thầy.
Code này của bác siwtom mình có thêm một số cái: chỉnh sửa công thức không cần xóa dấu "=", tô màu đỏ kết quả cho dễ nhìn. Nhưng còn 1 số vấn đề nhờ các anh giải quyết giúp:Rất cảm ơn code này rất đúng ý em. xong em test thấy lúc mình edit thì phải sửa lại và phải xoá đi kết quả và dấu bằng rất bất tiện. híc! cụ thể:
Khi đả đánh vào:
Móng M1: 1,2*2*3 -> enter ra: 1,2*2*3 = 7,2. Trong quá trình tính toán em edit thì:
- Nếu sửa: Móng M1: 1,1*2*3 (sửa "1,2"->1,1 và xóa "=7,2") thi ra kết quả đúng.
- Nếu sửa: Móng M1:1,1*2*3 = 7,2 thi hiển thị kết quả: Móng M1: 1,1*2*3 = 7,2 = 0,00 (sai) em muốn chi edit biểu thức thì nó tự replece kết quả được không?.
Chúc các bác sức khỏe!
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 Worksheet_Change(ByVal Target As Range)
Dim expression, ketqua, bieuthuc As String, result, result2 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
ketqua = Trim(Split(Target.Value, "=")(1))
bieuthuc = Trim(Split(Target.Value, "=")(0))
Else: bieuthuc = Target.Value
End If
If InStr(Target, ":") > 0 Then
'expression = Trim(Split(Target.Value, ":")(1))
expression = Trim(Split(bieuthuc, ":")(1))
Else
'expression = Trim(Target.Value)
expression = Trim(bieuthuc)
End If
expression = Replace(expression, ",", ".")
Application.EnableEvents = False
On Error Resume Next
result = Evaluate(expression)
On Error Resume Next
result2 = Evaluate(ketqua)
If result = 0 Then
If result2 <> 0 Then
Target.Value = "'" & Trim(bieuthuc)
End If
Else
Target.Value = "'" & Trim(bieuthuc) & " = " & FormatWithComma(result)
Target.Characters(1, InStr(Target, "=")).Font.Color = xlThemeColorLight2
Target.Characters(InStr(Target, "=") + 1).Font.Color = -16776961
End If
End If
End If
End If
end_:
Application.EnableEvents = True
End Sub
Ý bạn nói đến bài # nào nhỉ?Sao mình lưu code vào mà không chạy nhỉ. Bấm Alt+F11 lưu dưới dạng Addin. Cả nhà giúp mình với. Khi nhập diễn giải và công thức enter thì không ra kết quả.
Bạn đọc bài #66 của tôi chưa? Code tại #34 cũng tương tự code #64 mà tôi nói tới.Chào bác Lê Văn. Ý em hỏi code của bác và bác Siwtom thảo luận ấy. Em thấy hay quá nhưng khi e lưu dưới dạng addin thì không được. Bác chỉ cụ thể em cách sử dụng được không?
Thì đúng là code ở các bài trên đang là tự động nhảy ra kết quả nếu nhập xong dữ liệu và Enter.Bác nói là không lưu dưới dạng addin nhưng ý em hỏi làm cách nào để lưu code và sử dụng được code này để khi ta diễn giải khối lượng thì nó sẽ tự động ra kết quả. Em không làm được. Mong bác giúp
Cảm ơn thì có nút "Cảm ơn". Túm lại bạn chỉ muốn biết cách copy code trên diễn đàn cho vào file excel?Cám ơn bác. Em đã làm được rồi.
Theo tôi thì muốn lưu thành add in thì phải là 1 hàm nào đó. Còn đây là sự kiện thay đổi sau mỗi lần nhấn Enter.Cũng không hẳn như thế anh Văn à. Em thì chưa hiểu nhiều về vấn đề này nên hơi khó khăn. Mà bác cho em hỏi thêm mỗi lần diễn giải khối lượng đều phải copy code vào như thế này à? Không thể lưu vào và mở file nào lên cũng dùng được luôn à bác?
Bạn xem file đính kèm (cũng từ code trong những bài ở trên, bổ sung tí chút) giải quyết được vấn đề của Bạn:Code này của bác siwtom mình có thêm một số cái: chỉnh sửa công thức không cần xóa dấu "=", tô màu đỏ kết quả cho dễ nhìn. Nhưng còn 1 số vấn đề nhờ các anh giải quyết giúp:
1. khi nhập biểu thức -3+8 thì kết quả hiển thị là 5 = 5,0 ( đúng ra phải là -3+8 = 5,0)
2. nhập 4-3 hoặc 4/3 thì nó ra kết quả là ngày tháng năm (đúng ra phải là 4-3 = 1,0 hoặc 4/3 = 1,333.
[/CODE]
Bạn có thể Xoá hết diễn giải rồi lưu file dưới dạng template. Mỗi lầm mở lên thì làm và nó sẽ không ghi đè lên file template của Bạn.Cũng không hẳn như thế anh Văn à. Em thì chưa hiểu nhiều về vấn đề này nên hơi khó khăn. Mà bác cho em hỏi thêm mỗi lần diễn giải khối lượng đều phải copy code vào như thế này à? Không thể lưu vào và mở file nào lên cũng dùng được luôn à bác?
Bạn cứ thử trên máy bạn những thao tác như a Hòe hướng dẫn đi.Ý của anh Trần Hòe là lưu dưới dạng template thì mỗi lần mở 1 file excel bất kỳ thì sẽ dùng được luôn à a? có đưa vào addin không a? e vẫn chưa hiểu lắm. Mong a hồi âm sớm.
Đọc lại giáo trình Excel. Phân biệt addins và template.Ý của anh Trần Hòe là lưu dưới dạng template thì mỗi lần mở 1 file excel bất kỳ thì sẽ dùng được luôn à a? có đưa vào addin không a? e vẫn chưa hiểu lắm. Mong a hồi âm sớm.
Bạn xem file đính kèm (cũng từ code trong những bài ở trên, bổ sung tí chút) giải quyết được vấn đề của Bạn:
Tức bạn sửa dữ liệu mà vẫn để dấu "=" thì nó vẫn tính được cho bạn đúng không?Anh ơi! em thấy Code của anh edit chạy ok đúng như ý em cần. Anh có thể ra tay giúp thằng em chỉnh cái code này tí được không anh. Em cảm ơn anh trước nhe! Chúc anh sức khỏe!
________________________________________________
P/S:
Code của em cần sửa lỗi này anh:
Code trên còn tồn tại nhược điểm sau:
Khi đả đánh vào:
Móng M1: 1,2*2*3 -> enter ra: 1,2*2*3 = 7,2. Trong quá trình tính toán em edit thì:
- Nếu sửa: Móng M1: 1,1*2*3 (sửa "1,2"->1,1 và xóa "=7,2") thi ra kết quả đúng.
- Nếu sửa: Móng M1:1,1*2*3 = 7,2 thi hiển thị kết quả: Móng M1: 1,1*2*3 = 7,2 = 0,00 (sai) em muốn chi edit biểu thức thì nó tự replece kết quả được không?.
Chúc các bác sức khỏe!
File ở dưới thưa anh.
File ở #64 đã đáp ứng được yêu cầu của bạn rồi mà.Code trên còn tồn tại nhược điểm sau:
Khi đả đánh vào:
Móng M1: 1,2*2*3 -> enter ra: 1,2*2*3 = 7,2. Trong quá trình tính toán em edit thì:
- Nếu sửa: Móng M1: 1,1*2*3 (sửa "1,2"->1,1 và xóa "=7,2") thi ra kết quả đúng.
- Nếu sửa: Móng M1:1,1*2*3 = 7,2 thi hiển thị kết quả: Móng M1: 1,1*2*3 = 7,2 = 0,00 (sai) em muốn chi edit biểu thức thì nó tự replece kết quả được không?.
Chúc các bác sức khỏe!
File ở dưới thưa anh.
Tức bạn sửa dữ liệu mà vẫn để dấu "=" thì nó vẫn tính được cho bạn đúng không?
Bạn xem file đúng yêu cầu của bạn chư nhé!
Vẫn sử dụng bình thường mà Bạn!Cái bảng tính excel của anh TRANHOE hình như khi số vượt quá 1000 thì không được đúng không anh
Sao làm dự toán mà lười quá gõ sum vào là xong mà cũng lười biếng, lười thế này thế nhầm lẫn lém, lại ra thêm cây cầu thiếu trọng tải thì nguy, hihihii (vui chút cho các bạn cẩn trọng)
Muốn lười thì
Copy hết vào sheet code là được (sửa và thêm vào code của bác Siwtom trên)
PHP: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