Dim Dic As Object
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sRng As Range, Res(), Cot_DATA As Variant, i As Long, sRow As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
Set sRng = Intersect(Range("A5:A600000"), Target)
If Not sRng Is Nothing Then
If Dic Is Nothing Then Call CreateDic
If Not Dic Is Nothing Then
sRow = sRng.Rows.Count
ReDim Res(1 To sRow, 1 To 9)
For i = 1 To sRow
Cot_DATA = Dic.Item(sRng(i, 1).Value)
If TypeName(Cot_DATA) = "Variant()" Then
Res(i, 1) = Cot_DATA(0): _
Res(i, 2) = Cot_DATA(1): _
Res(i, 3) = Cot_DATA(2): _
Res(i, 4) = Cot_DATA(3): _
Res(i, 5) = Cot_DATA(4): _
Res(i, 6) = Cot_DATA(5): _
Res(i, 7) = Cot_DATA(6)
End If
Next i
sRng.Offset(0, 1).Resize(, 7).Value = Res
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub CreateDic()
Dim sArr As Variant, j As Long, k As Long, iKey
On Error Resume Next
With CreateObject("ADODB.Connection")
.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\DATA.xlsx;Extended Properties=""Excel 12.0;HDR=No"""
sArr = .Execute("select * from [DATA$B4:I60000] where f1 is not null").GetRows
End With
If Err.Number = 0 Then
Set Dic = CreateObject("Scripting.Dictionary")
For j = 0 To UBound(sArr, 2)
iKey = sArr(0, j)
If Len(iKey) > 0 Then
If Not Dic.exists(iKey) Then
Dic.Add iKey, Array(sArr(1, j), sArr(2, j), sArr(3, j), sArr(4, j), sArr(5, j), sArr(6, j), sArr(7, j))
End If
End If
Next
Else
MsgBox ("Khong tìm thay File du lieu")
On Error GoTo 0
End If
End Sub
)
