附件3万行的数据就会出现无响应,可以优化吗?

Sub 导入外部文件()
Dim X As Integer
Dim Y As Integer
sh3 = ThisWorkbook.Sheets("UUtranRelation").Cells(1048576, 3).End(xlUp).Row
de1 = ThisWorkbook.Sheets("删除小区信息").Cells(1048576, 1).End(xlUp).Row
Sheets("UUtranRelation").Activate
For X = sh3 To 6 Step -1
For Y = de1 To 2 Step -1
    If (Sheets("UUtranRelation").Cells(X, 5) = Sheets("删除小区信息").Cells(Y, 1) And Sheets("UUtranRelation").Cells(X, 6) = Sheets("删除小区信息").Cells(Y, 2)) Then
    Sheets("UUtranRelation").Cells(X, 2) = "D"
Exit For
    Else
    Sheets("UUtranRelation").Cells(X, 2) = "P"
    End If
    Next Y
    Next X
点击下载此附件End Sub