Em cảm ơn anh đã hỗ trợ nhiệt tình cho em!
Sáng nay em cũng sửa code như sau và em cũng thấy ổn anh à, mặc dù em có tắt sự kiện kích đúp chuột nhưng
khi em kích vào các ô thuộc dòng màu xanh đại diện cho cấp 2 (ví dụ I4 và M4) cần tính tổng thì vẫn bị xảy ra lỗi. Em sử dụng bẫy lỗi
ở các vị trí này thì không bị nữa anh ạ. Cũng là lần đầu tập viết sự kiện em nghĩ chắc cũng chưa đúng lắm hoặc còn rườm rà, mong các
anh xem qua, góp ý và sửa giúp em cho code tốt hơn ạ!
Với Thisworkbook
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngI As Range, rngM As Range
Dim lr_b1 As Long
Dim i As Integer, a As Integer, b As Integer, d As Integer, x As Integer
Dim c As Range, j As Integer, y As Integer, w As Long, z As Long
lr_b1 = Me.Sheets("B1").Range("F" & Rows.Count).End(xlUp).Row
Set rngI = Me.Sheets("B1").Range("I3:I" & lr_b1)
Set rngM = Me.Sheets("B1").Range("M3:M" & lr_b1)
If Target.CountLarge > 1 Then Exit Sub
If Target.CountLarge < 1 Then Exit Sub
'ElseIf Target.Column <> 9 And Target.Column <> 13 Then Exit Sub
If Not Intersect(Target, Union(rngI, rngM)) Is Nothing Then
Application.EnableEvents = False
If Not Intersect(Target, rngI) Is Nothing Then
If Target.Offset(0, -2) = "" And Target.Offset(0, -8) = "" Then
'----------xac dinh vi tri cap2 can tinh tong--------------
x = Target.Row
End If
End If
If Not Intersect(Target, rngM) Is Nothing Then
If Target.Offset(0, -12) = "" And Target.Offset(0, -7) = "" Then
x = Target.Row
End If
End If
With Sheets("B1")
a = x
Do Until a < x
For i = a To 3 Step -1
On Error Resume Next
If Range("A" & i).Value <> "" And Range("F" & i).Value <> "" Then
On Error GoTo 0
b = i
Exit Do
End If
Next
a = a - 1
Loop
a = x
Do Until a >= lr_b1
For i = a To lr_b1
On Error Resume Next
If Range("A" & i).Value <> "" And Range("F" & i).Value <> "" Then
On Error GoTo 0
d = i
Exit Do
End If
Next
a = a + 1
Loop
'Stop
'------------------xac dinh vi tri cap1 can tinh tong-------------------
a = x
Do Until a < x
For i = a To 3 Step -1
On Error Resume Next
If Left(Range("F" & i).Value, 4) Like "*-*" Or i = lr_b1 Then
On Error GoTo 0
j = i
Exit Do
End If
Next
a = a - 1
Loop
'Stop
a = x
Do Until a >= lr_b1
For i = a To lr_b1
On Error Resume Next
If Left(Range("F" & i).Value, 4) Like "*-*" Or i = lr_b1 Then
On Error GoTo 0
y = i
Exit Do
End If
Next
a = a + 1
Loop
On Error Resume Next
Cells(x, 14) = Cells(x, 9) - Cells(x, 13) 'cot N = Cot I - cot M
Cells(b, 9) = Application.WorksheetFunction.Sum(Range(Cells(b + 1, 9), Cells(d - 1, 9))) 'Tinh tong cho tieu chi cap2 cot I
Cells(b, 10) = Cells(b, 7) - Cells(b, 9) 'tieu chi cap2 cot J = cot G - cot I
Cells(b, 13) = Application.WorksheetFunction.Sum(Range(Cells(b + 1, 13), Cells(d - 1, 13))) 'Tinh tong cho tieu chi cap2 cot N
Cells(b, 14) = Cells(b, 9) - Cells(b, 13) 'tieu chi cap2 cot N = cot I - cot M
z = 0
w = 0
For i = j + 1 To y - 1 'dong vong lap de tim vung tinh tong cho c1
If Cells(i, 1) <> "" And Cells(i, 6) <> "" Then
'Stop
w = w + Cells(i, 9).Value
z = z + Cells(i, 13).Value
End If
Next i
'Stop
Cells(j, 9) = w 'tong cho C1 cot I
Cells(j, 10) = Cells(j, 7) - Cells(j, 9) 'tong cho C1 cot J = Cot G - COT N
Cells(j, 13) = z 'tong cho C1 cot M
Cells(j, 14) = Cells(j, 9) - Cells(j, 13) 'tong cho C1 cot N
On Error GoTo 0
End With
'End If
'End If
Application.EnableEvents = True
End If
End Sub
Với Worksheet
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Me.Range("I10,N57")) Is Nothing Then
Cancel = True 'huy bo su kien kich dup chuot
End If
End Sub
