Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
'On Error GoTo Err
If Target.Address = "$B$1" And Target.Value = "" Then
Dim Arr(), SArr, lRow As Long, lR As Long, item, sh As Worksheet, KQ
Sheet5.Range("A5:T65000").ClearContents
With CreateObject("Scripting.Dictionary")
For Each sh In Worksheets
If Left(sh.Name, 2) <> "RP" Then
SArr = sh.Range(sh.[A5], sh.[A65536].End(xlUp)).Resize(, 25).Value
For lRow = 1 To UBound(SArr, 1)
If SArr(lRow, 21) = Target Then ' column 21 la cot ky FCR
item = SArr(lRow, 8) & " " & SArr(lRow, 13)
If Not .Exists(item) Then
lR = lR + 1
.Add item, lR
KQ = Split(item, " ", 2)
ReDim Preserve Arr(1 To UBound(SArr, 1) * 3, 1 To 13)
Arr(lR, 1) = SArr(lRow, 6) ' ngay HD
Arr(lR, 2) = KQ(0) ' van don
Arr(lR, 3) = SArr(lRow, 7) ' head
Arr(lR, 4) = SArr(lRow, 9) ' cty
Arr(lR, 5) = SArr(lRow, 10) ' tax code
Arr(lR, 6) = SArr(lRow, 11) ' Dien giai
Arr(lR, 7) = SArr(lRow, 2) ' so hoa don
Arr(lR, 8) = KQ(1) ' ngoai te
Arr(lR, 9) = SArr(lRow, 12) ' truoc thue
Arr(lR, 10) = SArr(lRow, 16) ' thue
Arr(lR, 11) = SArr(lRow, 17) ' sau thue
Arr(lR, 12) = SArr(lRow, 14) ' ty gia
Arr(lR, 13) = SArr(lRow, 23) ' remark OSF
Else
Arr(.item(item), 9) = (Arr(.item(item), 9) + SArr(lRow, 12))
Arr(.item(item), 10) = (Arr(.item(item), 10) + SArr(lRow, 16))
Arr(.item(item), 11) = (Arr(.item(item), 11) + SArr(lRow, 17))
End If
End If
Next lRow
End If
Next sh
End With
Sheet6.Range("A5").Resize(lR, 13).Value = Arr
End If
'Err:
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Deactivate()
Sheet6.Range("A5:M20000").ClearContents
End Sub
