Option Explicit
Sub ABC()
Dim aHS(), aBM(), res(), S, dic As Object
Dim sR&, sC&, i&, r&, ir&, k&, j&, key$, hs$
With Sheet1 'Sheet Ho so
i = .Range("A1000000").End(xlUp).Row
If i < 2 Then MsgBox ("Khong co du lieu!"): Exit Sub
aHS = .Range("A2:I" & i + 1).Value2
End With
With Sheet2 'Sheet Bien Muc
i = .Range("A1000000").End(xlUp).Row
If i < 2 Then MsgBox ("Khong co du lieu!"): Exit Sub
aBM = .Range("A2:I" & i).Value2
End With
Set dic = CreateObject("scripting.dictionary")
sR = UBound(aHS) - 1: sC = UBound(aHS, 2)
ReDim res(1 To sR + UBound(aBM) * 2, 1 To sC)
For i = 1 To sR
key = aHS(i, 1)
For j = 2 To sC
key = key & "|" & aHS(i, j)
Next j
dic(key) = ""
Next i
For i = 1 To UBound(aBM)
dic(aBM(i, 1)) = dic(aBM(i, 1)) & "|" & i
Next i
hs = aHS(1, 1)
For i = 1 To sR
If aHS(i, 1) <> Empty Then
k = k + 1
For j = 1 To sC
res(k, j) = aHS(i, j)
Next j
If hs <> aHS(i + 1, 1) Then
If dic.exists(hs) Then
S = Split(dic(hs), "|")
For r = 1 To UBound(S)
ir = CLng(S(r))
key = aBM(ir, 1)
For j = 2 To sC
key = key & "|" & aBM(ir, j)
Next j
If dic.exists(key) = False Then
k = k + 1
For j = 1 To sC
res(k, j) = aBM(ir, j)
Next j
End If
Next r
End If
hs = aHS(i + 1, 1)
End If
End If
Next i
Sheet1.Range("G2").Resize(k).NumberFormat = "@"
Sheet1.Range("A2").Resize(k, sC) = res
Sheet1.Range("A2").Resize(k, sC).Borders.LineStyle = 1
End Sub