Option Explicit
Private Sub Worksheet_Calculate()
TapCode_PhieuXuat
End Sub
Private Sub TapCode_PhieuXuat()
Dim Data(), BangTra(), Inphieu(), dict As Object
Dim lR As Long, i As Long, j As Long, k As Integer
Dim r As Long, c As Integer, soPhieu As Long
Dim shtData As Worksheet, shtInPhieu As Worksheet
Set shtData = ThisWorkbook.Worksheets("data")
Set shtInPhieu = ThisWorkbook.Worksheets("in phieu")
Set dict = CreateObject("Scripting.Dictionary")
With shtData
lR = .Range("A" & Rows.Count).End(xlUp).Row
If lR < 2 Then Exit Sub
Data = .Range("A2:L" & lR).Value
For i = 1 To UBound(Data, 1)
dict.Item(Data(i, 3)) = i
Next i
End With
ReDim Inphieu(1 To 6, 1 To 8)
With shtInPhieu
soPhieu = .Range("I1").Value
BangTra = .Range("B43:J62").Value
For i = 1 To UBound(Data, 1)
If dict.exists(soPhieu) Then r = dict.Item(soPhieu)
If r = 0 Then GoTo Thoat
If Data(i, 12) = Data(r, 12) Then
k = k + 1
Inphieu(k, 1) = k
Inphieu(k, 2) = Data(i, 6)
Inphieu(k, 7) = Data(i, 7)
For j = 1 To UBound(BangTra, 1)
If Inphieu(k, 2) = BangTra(j, 1) Then
For c = 3 To 6
Inphieu(k, c) = BangTra(j, c - 1)
Next c
Inphieu(k, 8) = BangTra(j, 9)
End If
Next j
End If
Next i
.Range("A15").Resize(6, 8).Value = Inphieu
.Range("G2").Value = Data(r, 12)
Exit Sub
Thoat:
.Range("A15").Resize(6, 8).Value = Empty
.Range("G2").Value = Empty
End With
End Sub
