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

Liên hệ QC
vanle33

vanle33

Thành viên gạo cội
Tham gia
30/10/08
Bài viết
5,866
Được thích
3,953
Giới tính
Nam
Trong file đính kèm em muốn sau khi nhấn Enter thì sẽ ra kết quả ở cell B12 chứ không phải là cell A12. Tức là đổi dấu . thành dấu ,
Mong các anh chị em giúp tôi cách sửa code trong file đính kèm.
Thanks!
 

File đính kèm

  • Dien giai CT.xls
    29.5 KB · Đọc: 475
Sửa đoạn code này là xong thôi: Target = Replace(Cll, ".", ",") & " = " & Tinh
 
Còn 1 vấn đề này nữa.
Khi tôi nhấn Delete 1 cell ở cột A thì báo lỗi như hình

Phải sửa code như thế nào để không báo lỗi như trên nữa?
 
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
 
dhn46 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
vanle33 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bạ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
 
dhn46 đã viết:
Bạ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
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn
Nhưng mình muốn kết quả là S4 : 2,5*8,432*32 = 674,56
chứ không phải S4 : 2.5*8.432*32 = 674.56
Nghĩa là mình muốn như bài #3 đó!
 
vanle33 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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?
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....
 
dhn46 đã viết:
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?
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....
Nhấp chuột vào đây để mở rộng...
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
 
vanle33 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 đó.
 
dhn46 đã viết:
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 đó.
Nhấp chuột vào đây để mở rộng...
Máy mình ra kết quả như bài #8 đó.
Vậy thì bạn giúp mình chỉnh code để ra kết quả trên máy của bạn là 2,130.894 thì sau khi sang máy mình sẽ ra kết quả 2.130,894
 
dhn46 đã viết:
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 đó.
Nhấp chuột vào đây để mở rộng...

Bạn vào CP chọn "," làm dấu thập phân sau đó quay lại Excel dán chuỗi S4 : 2.5*8.432*32 vào cell nào đó thì sẽ có kết quả là S4 : 2.5*8.432*32 = 674.56
 
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
 
nmhung49 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Dù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
 
Lần chỉnh sửa cuối:
vodoi2x đã viết:
Dù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
Nhấp chuột vào đây để mở rộng...
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?
 
vanle33 đã viết:
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?
Nhấp chuột vào đây để mở rộng...

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

vẫn cần LƯU Ý.
+ Chỉ tính toán khi ô đó có chứa dấu ":"
+ 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
 
Lần chỉnh sửa cuối:
vodoi2x đã viết:
kế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
Nhấp chuột vào đây để mở rộng...
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,895
 
Vậy đạt yêu cầu chưa,

Nếu chưa thì sử dụng sub sau cho yên tâm,

PHP: 
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
vẫn cần LƯU Ý.
+ Chỉ tính toán khi ô đó có chứa dấu ":"
+ 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

phức tạp khi phải theo kiểu chuẩn lung tung thế này
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
2
Trả lời
21
Đọc
228
Hoàng Tuấn 868
H
S
Nhờ hỗ trợ code tìm kiếm dữ liệu bằng hộp tìm kiếm
Trả lời
4
Đọc
41
Hoàng Tuấn 868
H
NguyenNhan789556
  • Question
Viết code trong VBA
Trả lời
16
Đọc
152
VetMini
V
N
HÀM TÌM KIẾM CÓ ĐIỀU KIỆN
Trả lời
10
Đọc
362
Hoàng Tuấn 868
H
H
HÀM NỐI CHUỖI CONCAT NHIỀU ĐIỀU KIỆN
Trả lời
1
Đọc
30
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom