của mình nó vẫn là dấu phẩy và không có số 0 đằng trước như bạn. Mình muốn nhờ bạn xem và sửa lại code để có được số 0 đằng trước dấu phẩy
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo thoat
Dim i As Integer
Dim dau As Integer, cuoi As Integer
Dim DL As String, DGiai As String
Dim gt As String
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Column = 5 Then
If IsEmpty(Target) Or Cells(Target.Row, 1).Value <> 0 Then GoTo thoat1
If InStr(1, Target.Value, ":") > 0 Then
dau = InStr(1, Target.Value, ":")
Else
dau = 0
End If
If InStr(1, Target.Value, "=") > 0 Then
cuoi = InStr(1, Target.Value, "=") - 1
Else
cuoi = Len(Target.Value)
End If
If cuoi = dau Or cuoi < dau Then GoTo thoat1
DGiai = RTrim(LTrim(Left(Target.Value, cuoi)))
DL = RTrim(LTrim(Mid(Target.Value, dau + 1, cuoi - dau)))
DL = Replace(DL, ",", ".")
Target.Formula = DGiai & " = " & Round(Evaluate(DL), 3)
Target.Characters(Start:=Len(DGiai) + 4, Length:=Len(Round(Evaluate(DL), 3))).Font.ColorIndex = 3
Target.Interior.ColorIndex = xlNone
For i = Target.Row To 1 Step -1
If Cells(i, 1).Value > 0 Then
If DiengiaiTL(Cells(Target.Row + 1, Target.Column)) = 0 Then
Cells(i, 7).Formula = "=DiengiaiTL(E" & (i + 1) & ":E" & Target.Row & ")"
Else
gt = Cells(i, 7).Formula
Cells(i, 7).Formula = gt
End If
Exit For
End If
Next
GoTo thoat1
thoat:
Target.Interior.ColorIndex = 0
End If
thoat1:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Và modules của nó như này:
Option Explicit
Function DiengiaiTL(Vung As Range)
Dim Cll As Range
Dim gt As String
Application.Calculation = xlCalculationManual
For Each Cll In Vung
gt = Cll.Value
If InStr(1, gt, "=") > 0 Then
gt = RTrim(LTrim(Right(gt, Len(gt) - InStr(1, gt, "="))))
gt = Replace(gt, ",", ".")
DiengiaiTL = DiengiaiTL + Evaluate(gt)
End If
Next
DiengiaiTL = Round(DiengiaiTL, 3)
Application.Calculation = xlCalculationAutomatic
End Function
