Chỉnh sửa code tính Diễn giải Khối lượng trong Xây dựng

siwtom · 27/2/14

vanle33 đã viết:
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

Bạn thử kiểm tra xem
------------
Trong diễn giải:

1. Phải có ký tự ":". Sau ký tự ":" là biểu thức.
2. Chỉ dùng dấu chấm "." làm dấu thập phân

code của sheet

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))
                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

vanle33 · 27/2/14

siwtom đã viết:
Bạn thử kiểm tra xem
------------
Trong diễn giải:

1. Phải có ký tự ":". Sau ký tự ":" là biểu thức.
2. Chỉ dùng dấu chấm "." là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 "."

siwtom · 27/2/14

vanle33 đã viết:
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 "."

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ỗ đỏ đỏ là mới thêm vào. Bạn test thử xem

vanle33 · 27/2/14

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.

siwtom · 27/2/14

vanle33 đã viết:
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.

sitow?

Không có khiếu nại đâu. Lúc đó thì có mà tìm chim trên trời, tìm cá dưới biển ...

vanle33 · 27/2/14

siwtom đã viết:

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ỗ đỏ đỏ là mới thêm vào. Bạn test thử xem

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.

thanhlanh · 27/2/14

Bạ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)

vanle33 · 27/2/14

thanhlanh đã viết:
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)

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.

thanhlanh · 27/2/14

vanle33 đã viết:
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.

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.
Còn vẫn muốn tìm mã hiệu thì mới phải khởi động chương trình, lúc này bấm phải chuột cột C sẽ thấy mục tìm mã hiệu.

siwtom · 27/2/14

vanle33 đã viết:
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.

Nếu bạn dùng tập tin của bạn thanhlanh thì bạn phải sửa code. Vì ...

Hiện thời nếu bạn nhập biểu thức mà dùng dấu phẩy làm dấu thập phân (bạn muốn thế) và bạn có trong CP dấu chấm là dấu thập phân, hoặc gửi cho đối tác mà đối tác có như thế:

Mã:

(49,2-4,2+0,5)*1,0*0,9*1,3*100

thì kết quả sẽ có

Mã:

(49.2-4.2+0.5)*1.0*0.9*1.3*100=5 323.500

Tức

1. Dấu phẩy "," nhập vào sẽ bị chuyển thành dấu chấm ".", mà bạn muốn giữ nguyên.
2. Kết quả cũng có dấu chấm là dấu thập phân, còn bạn muốn có dấu phẩy bất luận trong CP thế nào
3. Nếu bạn có hoặc đối tác có trong CP dấu cách " " là phân biệt hàng nghìn, triệu thì bạn cũng có trong kết quả dấu cách như ở trên. Mà bạn lại muốn có dấu phân cách hàng nghìn, triệu là dấu chấm bất luận trong CP thế nào.
----------------
Dữ liệu hiện hành có dạng

Mã:

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

Vậy biểu thức là sau ký tự ":"

Bây giờ bạn muốn không gõ ":" thì làm sao code biết biểu thức bắt đầu từ đâu? Bạn duyệt bằng mắt và có tư duy thì bạn biết được chứ code chỉ nhìn thấy một chuỗi ký tự thì làm sao nó biết được?

Còn nếu không gõ ":" thì cũng không gõ cả "Xây tường trục A" v...v, tức chỉ có biểu thức (12-4)*0,22*3,6?

Tức dữ liệu hoặc có dạng

Xây tường trục A : (12-4)*0,22*3,6

hoặc có dạng

(12-4)*0,22*3,6

???

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 <> "" 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

vanle33 · 27/2/14

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à.

siwtom · 27/2/14

vanle33 đã viết:
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à.

Sao lại có chuyện yêu cầu nhỏ giọt thế này? Thành viên có 2,243 bài mà còn thế sao?

Ta gõ biểu thức trong ô cột A --> ENTER --> cũng trong ô vừa gõ chuyển thành "biểu thức = kết quả" đồng thời ô cùng dòng ở cột B chỉ có "kết quả" không có "biểu thức = "???????

Nếu thế thì

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 quả" sang ô bên cạnh (B) thì để 1, sang ô bên cạnh nữa (C) thì sửa thành 2, nữa (D) thì sửa thành 3. Chỗ đỏ đỏ ấy.

vanle33 · 27/2/14

siwtom đã viết:
Sao lại có chuyện yêu cầu nhỏ giọt thế này? Thành viên có 2,243 bài mà còn thế sao?

Ta gõ biểu thức trong ô cột A --> ENTER --> cũng trong ô vừa gõ chuyển thành "biểu thức = kết quả" đồng thời ô cùng dòng ở cột B chỉ có "kết quả" không có "biểu thức = "???????

Nếu thế thì

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 quả" sang ô bên cạnh (B) thì để 1, sang ô bên cạnh nữa (C) thì sửa thành 2, nữa (D) thì sửa thành 3. Chỗ đỏ đỏ ấy.

Qua quá trình sử dụng thì mới phát sinh vấn đề mà bác.
Trong hình ở dưới thì bị mấy cell B35, B8 kết quả ra không phải là số nên tại B32 em đặt SUM không được.
Bác chỉnh em với ạ.

siwtom · 27/2/14

vanle33 đã viết:
Qua quá trình sử dụng thì mới phát sinh vấn đề mà bác.
Trong hình ở dưới thì bị mấy cell B35, B8 kết quả ra không phải là số nên tại B32 em đặt SUM không được.
Bác chỉnh em với ạ.

Thì yêu cầu của bạn quái gở nên nó thế thôi.
Chính ra muốn là số thì phải theo CP. Đằng này bạn bắt kết quả phải có dấu thập phân là dấu phẩy, bất chấp trong CP thế nào, vậy khi trong CP bạn thiết lập dấu chấm "." là dấu thập phân thì rõ ràng kết quả 144.842,006 và 7.836,48 không là số thì đúng rồi.

Bạn hãy định nghĩa lại dạng kết quả ở cột A và B thì mới chiều được
---------
Thôi được, ta qui định thế này. Bất chấp trong CP thế nào thì trong cột A ta có "biểu thức = kết quả" mà trong đó "kết quả" phải có dấu phẩy là dấu thập phân và phân cách dùng dấu chấm NHƯNG trong cột B thì phải có dạng SỐ, tức theo CP.

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 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

Bạn test thử xem.

Mệt quá. Bạn ra gọi cho tôi 3 chai ken nhé.
À, nói với chị nhà xào một tí gì đó làm mồi nhé

vanle33 · 27/2/14

siwtom đã viết:
Thì yêu cầu của bạn quái gở nên nó thế thôi.
Chính ra muốn là số thì phải theo CP. Đằng này bạn bắt kết quả phải có dấu thập phân là dấu phẩy, bất chấp trong CP thế nào, vậy khi trong CP bạn thiết lập dấu chấm "." là dấu thập phân thì rõ ràng kết quả 144.842,006 và 7.836,48 không là số thì đúng rồi.

Bạn hãy định nghĩa lại dạng kết quả ở cột A và B thì mới chiều được

Cám ơn bác
Hóa ra em chỉ cần xóa dấu chấm trong các cell B35, B38 thì sẽ SUM được.

matran25251325 · 28/2/14

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.

vanle33 · 28/2/14

matran25251325 đã viết:
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.

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 --=0

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.

siwtom · 28/2/14

vanle33 đã viết:
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.

Bạn cứ giả vờ không biết vụ ken và mồi nhậu hả?

matran25251325 · 28/2/14

vanle33 đã viết:
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ác --=0

. 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

vanle33 · 28/2/14

siwtom đã viết:
Bạn cứ giả vờ không biết vụ ken và mồi nhậu hả?

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.

Chỉnh sửa code tính Diễn giải Khối lượng trong Xây dựng

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên tích cực

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

Thành viên tích cực

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên tiêu biểu

File đính kèm

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

Thành viên gắn bó

Thành viên tiêu biểu

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

Facebook

Group