Sub tonghop()
Dim i As Long, lr As Long, dic As Object, dk As String, arr, kq, cn As Object, duonglinh As String, sql As String, b As Long, a As Long
Set dic = CreateObject("scripting.dictionary")
Set cn = CreateObject("ADODB.Connection")
duonglinh = ThisWorkbook.Path & "\File 2.xlsx"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & duonglinh & ";Extended Properties=""Excel 12.0;HDR=No"";"
sql = "Select * From [File2$A3:D100000] where f2 is not null"
arr = chuyenmang(cn.Execute(sql).getrows)
ReDim kq(1 To UBound(arr) + 1000, 1 To 6)
For i = 1 To UBound(arr)
dk = arr(i, 1)
If Not dic.exists(dk) Then
a = a + 1
dic.Add dk, a
kq(a, 1) = arr(i, 1)
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
kq(a, 4) = arr(i, 4)
End If
Next i
cn.Close
duonglinh = ThisWorkbook.Path & "\File 1.xlsx"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & duonglinh & ";Extended Properties=""Excel 12.0;HDR=No"";"
sql = "Select * From [File1$A3:D100000] where f2 is not null"
arr = chuyenmang(cn.Execute(sql).getrows)
For i = 1 To UBound(arr)
dk = arr(i, 1)
If Not dic.exists(dk) Then
a = a + 1
dic.Add dk, a
kq(a, 1) = arr(i, 1)
kq(a, 2) = arr(i, 2)
kq(a, 5) = arr(i, 3)
kq(a, 6) = arr(i, 4)
Else
b = dic.Item(dk)
kq(b, 5) = arr(i, 3)
kq(b, 6) = arr(i, 4)
End If
Next i
cn.Close
With Sheet1
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr > 5 Then .Range("A6:F" & lr).ClearContents
.Range("A6:F6").Resize(a).Value = kq
End With
Set dic = Nothing
Set cn = Nothing
End Sub
Private Function chuyenmang(ByVal arr) As Variant
Dim kq(), i As Long, j As Long
ReDim kq(1 To UBound(arr, 2) + 1, 1 To UBound(arr, 1) + 1)
For i = LBound(arr, 2) To UBound(arr, 2)
For j = LBound(arr, 1) To UBound(arr, 1)
kq(i + 1, j + 1) = arr(j, i)
Next j
Next i
chuyenmang = kq
End Function
