Option Explicit
Public Sub BinhTinh(ByVal sheetTotal As Worksheet)
Dim dict As Object
Dim sheetDataLot As Worksheet
Dim dataLot() As Variant, key As Variant
Dim strTong As String
Dim i As Long, j As Long, lastRow As Long
strTong = "T" & ChrW(7893) & "ng" '<-- Tên sheet Tổng
On Error GoTo End_
Set sheetDataLot = ThisWorkbook.Worksheets("datalot")
Set sheetTotal = ThisWorkbook.Worksheets(strTong)
Set dict = CreateObject("Scripting.Dictionary")
lastRow = sheetDataLot.Cells(Rows.Count, "D").End(xlUp).Row
If lastRow < 2 Then
MsgBox "Khong co gi!", vbCritical + vbOKOnly, "Xin cam on"
Exit Sub
End If
dataLot = sheetDataLot.Range("D2:G" & lastRow).Value
For i = 1 To UBound(dataLot, 1)
If Not dict.exists(dataLot(i, 1)) Then
dict.Add dataLot(i, 1), Array(dataLot(i, 3), dataLot(i, 4))
End If
Next i
lastRow = sheetTotal.Cells(Rows.Count, "G").End(xlUp).Row
If lastRow < 2 Then
MsgBox "Khong co gi!", vbCritical + vbOKOnly, "Xin cam on"
Exit Sub
End If
Dim arrG, arrJ, arrK, arrL, arrM, arrGK, arrT, sumU
Dim arrP() As Variant, arrQ() As Variant
Dim total As Double
ReDim arrP(2 To lastRow), arrQ(2 To lastRow)
arrG = sheetTotal.Range("G2:G" & lastRow).Value
arrJ = sheetTotal.Range("J2:J" & lastRow).Value
arrK = sheetTotal.Range("K2:K" & lastRow).Value
arrL = sheetTotal.Range("L2:L" & lastRow).Value
arrGK = sheetTotal.Range("G2:K" & lastRow).Value
sumU = sheetTotal.Range("U2:U" & lastRow).Value
arrT = sheetTotal.Range("T2:T" & lastRow).Value
ReDim arrM(1 To lastRow - 1, 1 To 1)
For i = 1 To lastRow
key = sheetTotal.Range("O" & i + 1).Value
If dict.exists(key) Then
arrP(i) = dict(key)(0)
arrQ(i) = dict(key)(1)
End If
If i = 2 Then
arrM(i - 1, 1) = arrJ(i, 1)
Else
If arrG(i, 1) = arrG(i - 1, 1) Then
arrM(i - 1, 1) = arrM(i - 2, 1) + arrJ(i, 1) + arrK(i, 1) - arrL(i, 1)
Else
arrM(i - 1, 1) = arrJ(i, 1)
End If
End If
total = 0
For j = LBound(arrGK, 1) To UBound(arrGK, 1)
If arrT(j, 1) = arrT(i, 1) And arrG(j, 1) = arrG(i, 1) Then
total = total + arrGK(j, 2) + arrGK(j, 3) - arrGK(j, 4)
End If
Next j
sumU(i, 1) = total
Next i
sheetTotal.Range("U2:U" & lastRow).Value = sumU
sheetTotal.Range("P2:P" & lastRow).Value = arrP
sheetTotal.Range("Q2:Q" & lastRow).Value = arrQ
sheetTotal.Range("M2:M" & lastRow).Value = arrM
End_:
Application.EnableEvents = True
End Sub
