Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, allRng As Range, sRng As Range, aRng As Range
Dim lRs As Long, Jj As Long, Ii As Long, Timer_ As Double
Dim ro As Long
Dim a1(), a2(), a0()
Dim r0 As Range, r1 As Range, r2 As Range, r3 As Range
'----------------------------------------------------------------------------
If Target.Address = "$A$2" Then
Timer_ = Timer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'----------------------------------------------------------------------------
Set Rng = Sheets("ton").[a1].CurrentRegion
Rng.AdvancedFilter 2, [A1:A2], [B2:D2]
Set Rng = Sheets("ban").[a1].CurrentRegion
Rng.AdvancedFilter 2, [A1:A2], [G2:H2]
'[B3:D65535].SpecialCells(2, 23).Sort Key1:=[C3], Order1:=1, DataOption1:=1
'[G3:H65535].SpecialCells(2, 23).Sort Key1:=[G3], Order1:=1, DataOption1:=1
On Error Resume Next
[E3:F65535].SpecialCells(2, 23).ClearContents
'----------------------------------------------------------------------------
lRs = [b65500].End(xlUp).Row
ro = [G65000].End(xlUp).Row
Set ra = Range([C1], Cells(lRs, "C")) ' cot chua ma hang
Set r0 = Range([D1], Cells(lRs, "D")) ' cot chua ton1
Set r1 = Range([E1], Cells(lRs, "E")) ' cot chua gia ban
Set r2 = Range([F1], Cells(lRs, "F")) ' cot chua ton2
Set r3 = Range([G1], Cells(ro, "H")) ' cot chua gia ban
ReDim a1(lRs): ReDim a2(lRs): ReDim a0(lRs)
a1 = r1: a2 = r2: a0 = r0
For Ii = 3 To ro
k = WorksheetFunction.Match(r3.Cells(Ii, 1), ra, 0)
If k > 0 Then
t = r3.Cells(Ii, 2)
a1(k, 1) = t
a2(k, 1) = a0(k, 1) - t
End If
Next
r1 = a1: r2 = a2
'----------------------------------------------------------------------------
Names("Extract").Delete
Names("Criteria").Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
[J1] = Format(Timer - Timer_, "0#.###")
End If
End Sub
: theo G
