Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dulieu, Ketqua, I As Long, K As Long, Ivl As Long, Inc As Long, Imay As Long
Dim VL As String, Nc As String, May As String, LaMa As Long
Dim Ma As String, Mahieu As String, Er As Long, dongcuoi As Long
VL = "V" & ChrW$(7853) & "t li" & ChrW$(7879) & "u"
Nc = "Nh" & ChrW$(226) & "n c" & ChrW$(244) & "ng"
May = "M" & ChrW$(225) & "y"
On Error Resume Next
If Not Intersect(Target, [B7:B10000]) Is Nothing Then
If Target.Count = 1 Then
Mahieu = Sheets("XuatDL").Range("B" & Target.Row)
With Sheets("CSDL DM")
Dulieu = .Range("B8", .Range("B65535").End(3)).Resize(, 7)
End With
ReDim Ketqua(1 To UBound(Dulieu), 1 To 7)
For I = 1 To UBound(Dulieu)
Ma = Dulieu(I, 1)
If Ma = Mahieu Then
K = K + 1
If K = 1 Then
Ketqua(K, 2) = "=VLOOKUP(RC[-2],'CSDL tenCV'!R6C2:R1800C4,2,0)"
Ketqua(K, 3) = "=VLOOKUP(RC[-3],'CSDL tenCV'!R6C2:R1800C4,3,0)"
End If
If K > 1 Then
If Dulieu(I, 5) = VL Then
Ivl = Ivl + 1
If Ivl = 1 Then
LaMa = LaMa + 1
Ketqua(K, 2) = ChrW(LaMa + 96) & "). " & VL
K = K + 1
End If
Ketqua(K, 1) = Dulieu(I, 2): Ketqua(K, 2) = Dulieu(I, 3): Ketqua(K, 5) = Dulieu(I, 4)
End If
If Dulieu(I, 5) = Nc Then
Inc = Inc + 1
If Inc = 1 Then
LaMa = LaMa + 1
Ketqua(K, 2) = ChrW(LaMa + 96) & "). " & Nc
K = K + 1
End If
Ketqua(K, 1) = Dulieu(I, 2): Ketqua(K, 2) = Dulieu(I, 3): Ketqua(K, 5) = Dulieu(I, 4)
End If
If Dulieu(I, 5) = May Then
Imay = Imay + 1
If Imay = 1 Then
LaMa = LaMa + 1
Ketqua(K, 2) = ChrW(LaMa + 96) & "). " & May
K = K + 1
End If
Ketqua(K, 1) = Dulieu(I, 2): Ketqua(K, 2) = Dulieu(I, 3): Ketqua(K, 5) = Dulieu(I, 4)
End If
End If
End If
Next I
If K Then
Er = Target.End(xlDown).Row: dongcuoi = Range("D" & Rows.Count).End(3).Row
If Er < dongcuoi Then
Range("A" & Target.Row + 1 & ":G" & Er - 1).Delete
Range("A" & Target.Row + 1 & ":G" & Target.Row + 1).Resize(K - 1).EntireRow.Insert
End If
Target.Offset(, -1).ClearContents
If Target.Row = 7 Then
Target.Offset(, -1) = 1
Else
Target.Offset(, -1) = Application.Max(Range("A7:A" & Target.Row - 1)) + 1
End If
Target.Offset(, 1).Resize(K, 5) = Ketqua
Range("A" & Target.Row & ":G" & Target.Row).Resize(K).Borders.LineStyle = 1
Range("A" & Target.Row & ":G" & Target.Row).Resize(K).Borders(xlInsideHorizontal).Weight = xlHairline
End If
End If
End If
End Sub
. Em làm file bài 19
