Thử code . . .
Sub xyz()
Dim arr(), dk(), res()
Dim sR&, i&, j&, fY&, fD&, ck&
On Error Resume Next
With Sheets("Sheet1")
fY = .Range("B1").Value
fD = .Range("B2").Value
arr = .Range("B3:AW" & .Range("A1000000").End(xlUp).Row).Value
sR = UBound(arr)
dk =...