Máy bị down khi chạy macro này ạ (1 người xem)

[dungb]

EM chào cả nhà,
sau mấy ngày lặn ngụp ở GPE và với sự giúp đỡ ban đầu của bác ndu96081631 thì em viết được cái code như này. Nó dài dòng và loằng ngoằng nhưng em mới nghĩ đc đến đấy thôi
Vấn đề là lúc đầu thì chạy cũng đc nhưng sau khi em thêm thắt mấy thứ vào thì down luôn. Em save as sang đuôi .xlsm, thấy file nhẹ đi rất nhiều nhưng chạy vẫn chậm
dữ liệu trong file này em đã cắt đi nhiều rồi ạ, bt dữ liệu của em lên đến gần 4000 lines
Nhờ các bác xem giúp em
Em cám ơn
Em gửi code trc vì em loay hoay mãi mà resize dc file, em chỉ đc gửi 130k mà zip mãi mới đc 168k (dữ liệu chỉ có chục dòng) ( Như vậy là sao ạ ????

Sub Filter()
Dim rData As Range, rtarget As Range, rcrit As Range, i As Long, j As Long

On Error Resume Next
''' Xoa du lieu Filter

Sheets("Filter").Cells.Select
Selection.ClearContents
'''' Loc ra sheet Filter voi dieu kien Value date> report date va Trade date <= report date

With Sheets("data lich su")
    Set rData = .Range("A4:W400")
    Set rtarget = Sheets("Filter").Range("A4:W400")
        rtarget.Parent.UsedRange.ClearContents
        rtarget.Parent.Range("Iv1").Value = .Range("L4").Value
        rtarget.Parent.Range("iu1").Value = .Range("Q4").Value
        rtarget.Parent.Range("IU2").Value = "<=" & CLng(.Range("A1").Value)
        rtarget.Parent.Range("IV2").Value = ">" & CLng(.Range("A1").Value)
    Set rcrit = rtarget.Parent.Range("IU1:IV2")
    rData.AdvancedFilter 2, rcrit, rtarget
    rcrit.ClearContents
End With

With Sheets("DataInput")
Sheets("DataInput").Cells.Select
Selection.ClearContents
    
    Set rinput = .Range("A4:K400")
    rinput(1, 1).Value = "Hop dong"
    rinput(1, 2).Value = "Tien te mua"
    rinput(1, 3).Value = "Ngay mua"
    rinput(1, 4).Value = "So luong mua"
    rinput(1, 5).Value = "Tien te ban"
    rinput(1, 6).Value = "Ngay ban"
    rinput(1, 7).Value = "So luong ban"
    rinput(1, 8).Value = "thoi han con lai"
    rinput(1, 9).Value = "thang"

'''' tach amount mua/ban

    For i = 2 To 400
      If rtarget(i, 3) = "BUY" Or rtarget(i, 3) = "Buy" Or rtarget(i, 3) = "buy" Then
        
        rinput(i, 2) = rtarget(i, 5)
        rinput(i, 3) = rtarget(i, 12)
        rinput(i, 4) = rtarget(i, 6)
        rinput(i, 5) = rtarget(i, 8)
        rinput(i, 7) = rtarget(i, 10)
        rinput(i, 6) = rtarget(i, 12)
      Else
        rinput(i, 5) = rtarget(i, 5)
        rinput(i, 6) = rtarget(i, 12)
        rinput(i, 7) = rtarget(i, 6)
        
        rinput(i, 2) = rtarget(i, 8)
        rinput(i, 3) = rtarget(i, 12)
        rinput(i, 4) = rtarget(i, 10)
        
      End If
        rinput(i, 1) = rtarget(i, 1)
        rinput(i, 8).Value = rinput(i, 6).Value - Sheets("data lich su").Range("A1").Value
        If rinput(i, 8) <> "" Then
        rinput(i, 9) = Application.WorksheetFunction.VLookup(rinput(i, 8), Sheet3.Range("A1:B10"), 2, 1)
        Else: rinput(i, 9) = ""
        End If
    Next i
End With
End Sub

 

[dungb]

Không có bác nào xem giúp em ạ