Sub TINH()
Soluong
Dim DTinput(), CKarr(), Arr()
Dim i, j As Long, Rws As Long, Tem As String, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Che do CK")
CKarr = .Range("A4:T" & .Range("A4").End(xlDown).Row).Value
For i = 1 To UBound(CKarr)
Tem = CKarr(i, 1) & "#" & CKarr(i, 3)
If Not Dic.exists(Tem) Then Dic.Add Tem, i
Next i
End With
Application.ScreenUpdating = False
With Sheets("Data input")
DTinput = .Range("A5:D" & .Range("A5").End(xlDown).Row).Value
ReDim Arr(1 To UBound(DTinput), 1 To 15)
For i = 1 To UBound(DTinput)
Tem = DTinput(i, 1) & "#" & DTinput(i, 2)
If Dic.exists(Tem) Then
Rws = Dic.Item(Tem)
If Rws > 0 Then
For j = 1 To 15
If Right(CKarr(1, j + 5), 2) = "kg" Then
Arr(i, j) = CKarr(Rws, j + 5) * DTinput(i, 3)
Else
Arr(i, j) = CKarr(Rws, j + 5) * DTinput(i, 4)
End If
Next j
End If
End If
Next i
Set Dic = Nothing
.Range("H5:V" & Range("H5").End(xlDown).Row).ClearContents
.Range("H5").Resize(UBound(Arr), 15) = Arr
.ListObjects("Table2").Resize .Range("A4:V" & Range("A5").End(xlDown).Row)
End With
Application.ScreenUpdating = True
End Sub
Sub Soluong()
Dim DTinput(), CKarr(), Arr()
Dim i, j As Long, Rws As Long, Tem As String, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data input")
DTinput = .Range("A5:D" & .Range("A5").End(xlDown).Row).Value
For i = 1 To UBound(DTinput)
Tem = DTinput(i, 1) & "#" & DTinput(i, 2)
If Not Dic.exists(Tem) Then Dic.Add Tem, i
Next i
End With
Application.ScreenUpdating = False
With Sheets("Che do CK")
CKarr = .Range("A5:C" & .Range("A5").End(xlDown).Row).Value
ReDim Arr(1 To UBound(CKarr), 1 To 1)
For i = 1 To UBound(CKarr)
Tem = CKarr(i, 1) & "#" & CKarr(i, 3)
If Dic.exists(Tem) Then
Rws = Dic.Item(Tem)
If Rws > 0 Then
Arr(i, 1) = DTinput(Rws, 3)
End If
End If
Next i
Set Dic = Nothing
.Range(.[E5], .[E65000].End(xlUp)).ClearContents
'.Range("C5:D" & Range("A5").End(xlDown).Row).ClearContents
.Range("E5").Resize(UBound(Arr), 1) = Arr
End With
Application.ScreenUpdating = True
End Sub
