Mình cảm ơn bạn nhiều nhé. đoạn code của bạn đúng ý mình rồi. Nhưng sao nó chỉ chạy độc lập, chứ khi mình gắn chung vào code của mình thì nó không chạy được vậy bạn. Bạn giup mình nhé. Mình muốn gắn đoạn code của bạn với đoạn code của mình vào chung.
Code của bạn mình sửa lại thế này.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E2:H999")) Is Nothing Then
Cells(Target.Row, "I").FormulaR1C1 = "=round(PRODUCT(RC[-4]:RC[-1]),4)"
End If
End Sub
Code của mình đây
Private Sub Worksheet_Change(ByVal Target As Range)
'Created by Ngo Tuan Anh
If Target.Cells.Count > 1 Then Exit Sub
'Dieu kien tong quat (1)
If Target.Column = 2 And Target.Row > 6 Then
Application.EnableEvents = False
'Them dau "." :
If Len(Target) = 7 Then Target = Left(Target, 2) & "." & Right(Target, 5)
'Chuyen chu HOA :
Target = UCase(Target)
Application.EnableEvents = True
'1. Voi phan tra MHCV:
'Dim Sh As Worksheet, Rng As Range, sRng As Range
'Set Sh = Worksheets("DonGia")
'Set Rng = Sh.Range(Sh.[a19], Sh.[A10000].End(xlUp))
Dim Wb As Workbook, Sh As Worksheet, Rng As Range, sRng As Range
Set Wb = Workbooks("DuToan-Excel.xls")
Set Sh = Wb.Sheets("DonGia")
Set Rng = Sh.Range(Sh.[A19], Sh.[A10000].End(xlUp))
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If Target = "TT" Then Target.Font.ColorIndex = 3
If Target <> "" And sRng Is Nothing Then
Target.Font.ColorIndex = 3
MsgBox "- Ma hieu don gia nay chua duoc cap nhat trong bang 'Don Gia'." + Chr(13) + "- Hay su dung MHDG cua 1 cong viec tuong tu hoac MHDG tam tinh <TT>." + Chr(13) + "- Truong hop muon ghi STT thi xin dung ghi vao cot nay, ghi chung vao cot ''Noi dung cong viec'' !", vbInformation, "Chu y:"
'GoTo KeKhung
Else
With Target
.Offset(0, -1) = "=COUNT(R6C:R[-1]C)+1"
.Offset(0, 1) = sRng.Offset(, 1).Value
.Offset(0, 2) = sRng.Offset(, 2).Value
.Offset(0, 9) = sRng.Offset(, 3).Value
.Offset(0, 10) = sRng.Offset(, 4).Value
.Offset(0, 11) = sRng.Offset(, 5).Value
.Offset(0, 12) = "=ROUND(RC[-9]*RC[-3],0)"
.Offset(0, 13) = "=ROUND(RC[-10]*RC[-3],0)"
.Offset(0, 14) = "=ROUND(RC[-11]*RC[-3],0)"
Application.EnableEvents = True
End With
End If
GoTo KeKhung
End If
'Het dieu kien tong quat (1)
'2. Voi phan tinh toan khoi luong:
'If Not Intersect(Target, Range("C7:C55555")) Is Nothing Then
If Target.Row < 7 Or Target.Column <> 3 Then Exit Sub
If Target.Offset(0, -1) <> "" Then Exit Sub
If Target = "" Then Exit Sub
'--------------------------------------------------------
If InStr(Target, "=") = False Then Exit Sub
If InStr(Target, ": ") Then
'Ta = Right(Target, Len(Target) - InStr(Target, ":") - 1)
Ta = Mid(Target, InStr(Target, ":") + 1, InStr(Target, "=") - InStr(Target, ":") - 1) ' <-- sua
Tb = Replace(Ta, " ", "")
KoCoDienGiai:
On Error GoTo LOI
Tc = Replace(Tb, ",", ".")
Tc = Replace(Tc, "x", "*")
Tc = Replace(Tc, "=", "")
Khoiluong = Round(Evaluate("=" & Tc), 3)
'Noi gia tri voi ket qua:
If Right(Target, 1) = "=" Or Khoiluong <> Replace(Right(Target, Len(Target) - InStr(Target, "=")), " ", "") Then ' <-- them
With Target
'.Value = .Value & " " & Khoiluong
.Value = Left(.Value, InStr(.Value, "=")) & " " & Khoiluong
.Font.ColorIndex = 9
.Characters(InStr(.Value, "=") + 1, Len(.Value)).Font.ColorIndex = 5
End With
Else: '<-- them
With Target
.Font.ColorIndex = 9
.Characters(InStr(.Value, "=") + 1, Len(.Value)).Font.ColorIndex = 5
End With
Exit Sub '<-- them
End If
Else:
Tb = Replace(Target, " ", "")
If IsNumeric(Left(Tb, 1)) Or Left(Tb, 1) = "(" Then
Tb = Left(Target, InStr(Target, "=") - 1) ' <-- them
GoTo KoCoDienGiai
Else: Exit Sub
End If
End If
'Sum Khoi Luong:
If WorksheetFunction.CountA(Range("B7:B55555")) = 0 Then Exit Sub
Set MHCV = Target.Offset(0, -1).End(xlUp)
m = Target.Offset(0, -1).End(xlUp).Row
'Neu la cong viec dau tien hoac cuoi cung:
If WorksheetFunction.CountA(Range("B" & Target.Row & ":B55555")) = 0 Then
n = [C55555].End(xlUp).Row
iR = m - n
Else:
'Neu la cac cong viec o giua:
n = Target.Offset(0, -1).End(xlDown).Row
iR = m - n + 1
End If
MHCV.Offset(0, 8) = "=SUM(R[0]C[-1]:R[" & -iR & "]C[-1])"
'End If
'-----------------------------
'Sum Chi tiet:
If WorksheetFunction.CountA(Range("B7:B55555")) = 0 Then Exit Sub
Set MHCV = Target.Offset(0, -1).End(xlUp)
m = Target.Offset(0, -1).End(xlUp).Row
'Neu la cong viec dau tien hoac cuoi cung:
If WorksheetFunction.CountA(Range("B" & Target.Row & ":B55555")) = 0 Then
n = [C55555].End(xlUp).Row
iR = m - n
Else:
'Neu la cac cong viec o giua:
n = Target.Offset(0, -1).End(xlDown).Row
iR = m - n + 3
End If
MHCV.Offset(0, 7) = "=PRODUCT(R[0]C[-4]:R[" & -iR & "]C[-1])"
'End If
'-----------------------------
KeKhung:
If [A55555].End(xlUp) <> "." Then
Dim R As Range
iR = [C55555].End(xlUp).Row
Set R = Range("A7
" & iR)
With R.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With R.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With R.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With R.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
On Error Resume Next 'Neu dang tren bang DonGia hoac vung chon = 1 dong
With R.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
Target.Offset(1).Select
End If
Exit Sub
'---------------------------------------
LOI:
Target.Characters(InStr(Target, ":") + 1, Len(Target)).Font.ColorIndex = 3
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Target.Column = 3 Then
Cancel = True
Application.Run "'DuToan-Excel.xls'!CallForm"
End If
End Sub
Nhờ bạn giúp mình ghép 2 đoạn đó vào một mà vẫn hoạt động bình thường. cám ơn bạn nhiều
