Làm sao để hiện thị cả công thức và kết quả trong exel giống như trương trình dự toán

[quoccuonghd]

Xin hỏi anh em trong diễn đàn GPE, liệu có cốt nào cho sheets để khi nhập các công thúc tính toán vẫn hiện cả diễn giải lẫn kết quả như hình đính kèm. thank's

 

[Let'GâuGâu]

Xin hỏi anh em trong diễn đàn GPE, liệu có cốt nào cho sheets để khi nhập các công thúc tính toán vẫn hiện cả diễn giải lẫn kết quả như hình đính kèm. thank's

bạn biết xài vba không?
bạn nhấn phím Alt F11 (mở cửa sổ vba)
bên tay trái màn hình, bạn thấy các sheet, nhấp chọn sheet mà cái bảng trên nằm ở sheet đó
chép đoạn code này vào)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pos, kq As Long, chuoi As String
On Error GoTo thoat
Application.EnableEvents = False

If Not Intersect(Target, [E2:E10000]) Is Nothing Then
    pos = InStr(1, Target, ":", vbBinaryCompare)
   If pos Then
        chuoi = Mid(Target.Value, InStr(1, Target, ":", vbBinaryCompare), Len(Target))
    Else
     chuoi = Target.Value
    End If
    kq = Cong(chuoi)
    If kq Then Target.Value = Target.Value & " = " & kq
End If

thoat:
Application.EnableEvents = True

End Sub

sau đó nhấp vào "insert" trên thành công cụ chọn module
chép đoạn code này vào

Function Cong(kytu As String)
    Dim objReg As Object
  
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "[^\d*/()+-]"
    objReg.Global = True

    Application.Calculation = False
        Cong = Evaluate(objReg.Replace(kytu, vbNullString))
  Application.Calculation = True

    Set objReg = Nothing
End Function

 

[quoccuonghd]

bạn biết xài vba không?
bạn nhấn phím Alt F11 (mở cửa sổ vba)
bên tay trái màn hình, bạn thấy các sheet, nhấp chọn sheet mà cái bảng trên nằm ở sheet đó
chép đoạn code này vào)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pos, kq As Long, chuoi As String
On Error GoTo thoat
Application.EnableEvents = False

If Not Intersect(Target, [E2:E10000]) Is Nothing Then
    pos = InStr(1, Target, ":", vbBinaryCompare)
   If pos Then
        chuoi = Mid(Target.Value, InStr(1, Target, ":", vbBinaryCompare), Len(Target))
    Else
     chuoi = Target.Value
    End If
    kq = Cong(chuoi)
    If kq Then Target.Value = Target.Value & " = " & kq
End If

thoat:
Application.EnableEvents = True

End Sub

sau đó nhấp vào "insert" trên thành công cụ chọn module
chép đoạn code này vào

Function Cong(kytu As String)
    Dim objReg As Object
  
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "[^\d*/()+-]"
    objReg.Global = True

    Application.Calculation = False
        Cong = Evaluate(objReg.Replace(kytu, vbNullString))
  Application.Calculation = True

    Set objReg = Nothing
End Function

Bạn ơi mình làm rồi, không ra kết quả tính, mình gửi file lên bạn viết lại cốt hộ nhé

 

[Let'GâuGâu]

Bạn ơi mình làm rồi, không ra kết quả tính, mình gửi file lên bạn viết lại cốt hộ nhé

tôi gặp phải vấn đề nan giải là cái định dạng dấu chấm "." và dấu phẩy "," để phân biệt số lẻ (decimal)
ở máy tôi tôi cài dấu chấm là định dạng số lẻ, kết quả là ok, nhưng khi đổi sang dấu "," thì thực sự bó tay

để test thử kết quả, bạn thử như sau:
bạn vào control panel cài lại decimal là dấu "."
khi bạn nhập liệu hoặc sửa chữa trong cell, nó sẻ ra kết quả tính cho bạn
=================
ok, có vẻ như tôi đã giải quyết được nó, bạn kiểm tra lại thử xem

 

[quoccuonghd]

Sao minh ko tai duoc file ban dinh kem xuong nhi?

 

[Let'GâuGâu]

Sao minh ko tai duoc file ban dinh kem xuong nhi?

bình thường mà.
ko tải đưỡ thì chép code này vào sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo thoat
Application.EnableEvents = False

Dim vtd, vtc, cd, kq As Long, chuoi, chuoi1 As String


Dim objReg As Object

 Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "[^\d().*/+-]"
    objReg.Global = True

If Not Intersect(Target, [E2:E10000]) Is Nothing Then
    vtc = InStr(1, Target, "=", 0)
    vtd = InStr(1, Target, ":", 0)
    cd = Len(Target.Value)
    chuoi1 = Target.Value
    If vtc Then chuoi1 = Mid(Target.Value, 1, vtc - 1): cd = vtc - vtd
    If vtd Then chuoi = Mid(chuoi1, vtd, cd)
    chuoi = Replace(chuoi, ",", ".")
    chuoi = Format(Evaluate(objReg.Replace(chuoi, vbNullString)), "#,##0.00")
    Target.Value = chuoi1 & " = " & chuoi
End If

thoat:
Application.EnableEvents = True
Set objReg = Nothing

End Sub

bỏ đoan code trong module đi

 

[xuvudo]

có vấn đề nữa là trong ô này nếu có dấu bằng thi code không hoạt động

tôi gặp phải vấn đề nan giải là cái định dạng dấu chấm "." và dấu phẩy "," để phân biệt số lẻ (decimal)
ở máy tôi tôi cài dấu chấm là định dạng số lẻ, kết quả là ok, nhưng khi đổi sang dấu "," thì thực sự bó tay

để test thử kết quả, bạn thử như sau:
bạn vào control panel cài lại decimal là dấu "."
khi bạn nhập liệu hoặc sửa chữa trong cell, nó sẻ ra kết quả tính cho bạn
=================
ok, có vẻ như tôi đã giải quyết được nó, bạn kiểm tra lại thử xem

=======================================
bạn xem và khắc phục lỗi này. thanks

 

[ndunghuong]

Tuyệt vời, bác Let go có code nào mà khi gõ các phép tính ví dụ 3*4 hay 4-3 hay 4:3 sau đó enter là nó cũng ra kết quả không?
( Vì code ở trên của bác chỉ thực hiện sau dấu :, nên khi gõ ko có dấu : ở đầu thì nó không thực hiện )

 

[ngxthanh]

bình thường mà.
ko tải đưỡ thì chép code này vào sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo thoat
Application.EnableEvents = False

Dim vtd, vtc, cd, kq As Long, chuoi, chuoi1 As String


Dim objReg As Object

 Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "[^\d().*/+-]"
    objReg.Global = True

If Not Intersect(Target, [E2:E10000]) Is Nothing Then
    vtc = InStr(1, Target, "=", 0)
    vtd = InStr(1, Target, ":", 0)
    cd = Len(Target.Value)
    chuoi1 = Target.Value
    If vtc Then chuoi1 = Mid(Target.Value, 1, vtc - 1): cd = vtc - vtd
    If vtd Then chuoi = Mid(chuoi1, vtd, cd)
    chuoi = Replace(chuoi, ",", ".")
    chuoi = Format(Evaluate(objReg.Replace(chuoi, vbNullString)), "#,##0.00")
    Target.Value = chuoi1 & " = " & chuoi
End If

thoat:
Application.EnableEvents = True
Set objReg = Nothing

End Sub

bỏ đoan code trong module đi

bạn ơi bạn có thể hướng dẫn cụ thể hơn được không.

 

[Let'GâuGâu]

bạn ơi bạn có thể hướng dẫn cụ thể hơn được không.

hỏi dzậy biết hướng dẫn cái gì?
tải bài #4 về xài thôi?

 

[dinhthi1028]

bạn biết xài vba không?
bạn nhấn phím Alt F11 (mở cửa sổ vba)
bên tay trái màn hình, bạn thấy các sheet, nhấp chọn sheet mà cái bảng trên nằm ở sheet đó
chép đoạn code này vào)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pos, kq As Long, chuoi As String
On Error GoTo thoat
Application.EnableEvents = False

If Not Intersect(Target, [E2:E10000]) Is Nothing Then
    pos = InStr(1, Target, ":", vbBinaryCompare)
   If pos Then
        chuoi = Mid(Target.Value, InStr(1, Target, ":", vbBinaryCompare), Len(Target))
    Else
     chuoi = Target.Value
    End If
    kq = Cong(chuoi)
    If kq Then Target.Value = Target.Value & " = " & kq
End If

thoat:
Application.EnableEvents = True

End Sub

sau đó nhấp vào "insert" trên thành công cụ chọn module
chép đoạn code này vào

Function Cong(kytu As String)
    Dim objReg As Object
  
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "[^\d*/()+-]"
    objReg.Global = True

    Application.Calculation = False
        Cong = Evaluate(objReg.Replace(kytu, vbNullString))
  Application.Calculation = True

    Set objReg = Nothing
End Function

sao mình cũng làm như thế mà k được vậy bạn

 

[Let'GâuGâu]

sao mình cũng làm như thế mà k được vậy bạn

tải file bài #4 về xem nha

 

[Vinh TN]

bạn biết xài vba không?
bạn nhấn phím Alt F11 (mở cửa sổ vba)
bên tay trái màn hình, bạn thấy các sheet, nhấp chọn sheet mà cái bảng trên nằm ở sheet đó
chép đoạn code này vào)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim pos, kq As Long, chuoi As String
On Error GoTo thoat
Application.EnableEvents = False

If Not Intersect(Target, [E2:E10000]) Is Nothing Then
    pos = InStr(1, Target, ":", vbBinaryCompare)
   If pos Then
        chuoi = Mid(Target.Value, InStr(1, Target, ":", vbBinaryCompare), Len(Target))
    Else
     chuoi = Target.Value
    End If
    kq = Cong(chuoi)
    If kq Then Target.Value = Target.Value & " = " & kq
End If

thoat:
Application.EnableEvents = True

End Sub

sau đó nhấp vào "insert" trên thành công cụ chọn module
chép đoạn code này vào

Function Cong(kytu As String)
    Dim objReg As Object
 
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "[^\d*/()+-]"
    objReg.Global = True

    Application.Calculation = False
        Cong = Evaluate(objReg.Replace(kytu, vbNullString))
  Application.Calculation = True

    Set objReg = Nothing
End Function

Bạn ơi, cái lỗi này là do đâu.

 

[dobaquyet]

Mình có file hay mà công thức dài quá không tính được ( không hiện ra kết quả) ai giúp mình chỉnh với
(Vui lòng không viết chữ in hoa toàn bộ nội dung bài viết, tham khảo nội quy diễn đàn - Moneymong.pt đã chỉnh lại cho đúng nội quy)