Sub NhapKho()
Dim TK As Variant, dArr As Variant, tArr(1 To 3), Arr As Variant
Dim tenVT As String, key As String, shName As String
Dim lR As Long, i As Long, k As Long, ik As Long
With Sheets("Sheet1")
sarr = .Range("I1:J3").Value
dArr = .Range("B11", .Range("F" & Rows.Count).End(xlUp)).Value
End With
lR = UBound(dArr)
ReDim Arr(1 To UBound(dArr) + 1, 1 To 8)
tArr(1) = Arr: tArr(2) = Arr: tArr(3) = Arr
With CreateObject("scripting.dictionary")
For i = 1 To UBound(dArr)
tenVT = Application.Trim(dArr(i, 1))
key = LCase(tenVT)
If InStr(key, sarr(1, 1)) Then
n = IIf(InStr(key, sarr(2, 1)), 2, IIf(InStr(key, sarr(3, 1)), 3, 1))
If Not .exists(key) Then
k = tArr(n)(lR, 1) + 1
.Add key, k
tArr(n)(lR, 1) = k
tArr(n)(k, 1) = k
tArr(n)(k, 2) = tenVT
tArr(n)(k, 4) = dArr(i, 2)
End If
ik = .Item(key)
tArr(n)(ik, 5) = tArr(n)(ik, 5) + dArr(i, 3)
tArr(n)(ik, 7) = tArr(n)(ik, 7) + dArr(i, 5)
End If
Next i
End With
For n = 1 To 3
For i = 1 To tArr(n)(lR, 1)
tArr(n)(i, 6) = Round(tArr(n)(i, 7) / tArr(n)(i, 5), 2)
Next i
With Sheets(sarr(n, 2))
k = .Range("B" & Rows.Count).End(xlUp).Row
If k > 6 Then .Range("A7:H" & k).ClearContents
.Range("A7").Resize(tArr(n)(lR, 1), 8) = tArr(n)
End With
Next n
End Sub
