Excel 我的VBA代码花费的时间太长了，有没有关于如何缩短时间的建议？For循环

我的代码旨在打开一个文件，复制文件的内容，将其粘贴到一个包含公式的工作文件中。这些公式确定是否应忽略一行。然后，代码遍历每一行，用“ignore”将该行复制到另一个选项卡中，然后删除该行。然后，代码查看是否为“INV NOT FOUND”，如果该行具有此名称，则会将该行复制到新工作簿中，并在遍历所有行后关闭并保存新工作簿。 我有一些5k+行的文件，这需要太长的时间

我真的不知道如何编写循环代码

Option Explicit

Sub RawData()
Dim CurrentDate As String
Dim PB As String
Dim ReturnsCheck As String
Dim Filename As String
Dim MyRange As String
Dim aWB As Workbook
Dim tWB As Workbook, newSheet As Worksheet
Dim MissingInvCount As Long
Dim rng As Range
Dim cell As Range
Dim search As String

Set tWB = ThisWorkbook

CurrentDate = Range("C6")
PB = Range("C8")

Application.EnableCancelKey = xlDisabled

Worksheets("data table").Visible = True

If tWB.Worksheets("home").Range("PB") = "Citi" Then
    Worksheets("sort area").Visible = True
ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
    Worksheets("pershing").Visible = True
ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
    Worksheets("jpm").Visible = True
ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
    Worksheets("gs").Visible = True
ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
    Worksheets("ms").Visible = True

End If

'Opens Raw file
    Workbooks.Open Filename:="G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\" & Range("PB") & "\" & Format(Range("CurrentDate"), "yyyy") & "\Raw Files\" & "Raw File - " & Range("PB") & " " & Format(Range("CurrentDate"), "mmddyy") & ".csv"


ActiveWorkbook.Activate
Set aWB = ActiveWorkbook

If tWB.Worksheets("home").Range("PB") = "Citi" Then
    aWB.Activate
       Range("A1", Range("CZ" & Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("sort area").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
    aWB.Activate
       Range("A1", Range("U" & Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("pershing").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
    aWB.Activate
       Range("A1", Range("AD" & Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("jpm").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
    aWB.Activate
       Range("A1", Range("V" & Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("gs").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
    aWB.Activate
       Range("A1", Range("L" & Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("ms").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If

'Closes Raw File w/o saving
    aWB.Close SaveChanges:=False

'Copy Formulas down
Dim Lastrow As Long

If tWB.Worksheets("home").Range("PB") = "Citi" Then
    Worksheets("sort area").Activate
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Range("DB2:FN" & Lastrow).FillDown
ElseIf Range("PB") = "Pershing" Then
    Worksheets("pershing").Activate
    Lastrow = Range("B" & Rows.Count).End(xlUp).Row
    Range("W2:BO" & Lastrow).FillDown
ElseIf Range("PB") = "JPM" Then
    Worksheets("jpm").Activate
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Range("AI2:CU" & Lastrow).FillDown
ElseIf Range("PB") = "Goldman Sachs" Then
    Worksheets("gs").Activate
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Range("X2:CJ" & Lastrow).FillDown
ElseIf Range("PB") = "Morgan Stanley" Then
    Worksheets("ms").Activate
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Range("N2:BZ" & Lastrow).FillDown

End If

'Remove ignored lines & Idenitifies missing investments

Dim n As Integer
Dim nLastRow As Long
Dim nFirstRow As Long
Dim r As Range


    Set r = ActiveSheet.UsedRange
    nLastRow = Lastrow - 1
    nFirstRow = 2


Dim i As Long: i = 1

With ActiveSheet
    On Error Resume Next
    Application.ScreenUpdating = False

    If tWB.Worksheets("home").Range("PB") = "Citi" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "DB") = "IGNORE" Then
                .Cells(n, "DB").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "DB").EntireRow.Delete
                i = i + 1
            End If
        Next

    ElseIf Range("PB") = "Pershing" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "W") = "IGNORE" Then
                .Cells(n, "W").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "W").EntireRow.Delete
                i = i + 1
            End If
        Next

    ElseIf Range("PB") = "JPM" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "AI") = "IGNORE" Then
                .Cells(n, "AI").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "AI").EntireRow.Delete
                i = i + 1
            End If
        Next

    ElseIf Range("PB") = "Goldman Sachs" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "X") = "IGNORE" Then
                .Cells(n, "X").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "X").EntireRow.Delete
                i = i + 1
            End If
        Next

    ElseIf Range("PB") = "Morgan Stanley" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "N") = "IGNORE" Then
                .Cells(n, "N").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "N").EntireRow.Delete
                i = i + 1
            End If
        Next

    End If
End With

'Sort Ignore tab
Worksheets("ignore").Activate
Lastrow = Cells(Rows.Count, 2).End(xlUp).Row

If tWB.Worksheets("home").Range("PB") = "Citi" Then
    Range("A1:FG" & Lastrow).SORT key1:=Range("DE1:DE" & Lastrow), _
     order1:=xlAscending, Header:=xlNo

ElseIf Range("PB") = "Pershing" Then
    Range("A1:BO" & Lastrow).SORT key1:=Range("Z1:Z" & Lastrow), _
     order1:=xlAscending, Header:=xlNo

ElseIf Range("PB") = "JPM" Then
    Range("A1:CU" & Lastrow).SORT key1:=Range("AL1:AL" & Lastrow), _
     order1:=xlAscending, Header:=xlNo

ElseIf Range("PB") = "Goldman Sachs" Then
    Range("A1:CJ" & Lastrow).SORT key1:=Range("AA1:AA" & Lastrow), _
     order1:=xlAscending, Header:=xlNo

ElseIf Range("PB") = "Morgan Stanley" Then
    Range("A1:BZ" & Lastrow).SORT key1:=Range("Q1:Q" & Lastrow), _
     order1:=xlAscending, Header:=xlNo

End If

'Missing investments

If tWB.Worksheets("home").Range("PB") = "Citi" Then

Worksheets("sort area").Activate
Set rng = ActiveSheet.Range("DF1:DF" & Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("sort area").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "DF") = "INV NOT FOUND" Then
                    .Cells(n, "DF").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "DF").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If Range("PB") = "Pershing" Then

Worksheets("pershing").Activate
Set rng = ActiveSheet.Range("AA1:AA" & Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("pershing").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "AA") = "INV NOT FOUND" Then
                    .Cells(n, "AA").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "AA").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If Range("PB") = "JPM" Then

Worksheets("jpm").Activate
Set rng = ActiveSheet.Range("AM1:AM" & Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("jpm").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "AM") = "INV NOT FOUND" Then
                    .Cells(n, "AM").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "AM").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If Range("PB") = "Goldman Sachs" Then

Worksheets("gs").Activate
Set rng = ActiveSheet.Range("AB1:AB" & Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("gs").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "AB") = "INV NOT FOUND" Then
                    .Cells(n, "AB").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "AB").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If Range("PB") = "Morgan Stanley" Then

Worksheets("ms").Activate
Set rng = ActiveSheet.Range("R1:R" & Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("ms").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "R") = "INV NOT FOUND" Then
                    .Cells(n, "R").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "R").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If MissingInvCount <> 0 Then
MsgBox ("There are " & MissingInvCount & " missing investments.")
End If

'Sort Missing Investments tab
If MissingInvCount <> 0 Then

    newSheet.Activate
    Lastrow = Cells(Rows.Count, 2).End(xlUp).Row

    If tWB.Worksheets("home").Range("PB") = "Citi" Then
        Range("A1:FN" & Lastrow).SORT key1:=Range("DC1:DC" & Lastrow), _
            order1:=xlAscending, Header:=xlNo
        Columns("DD:FN").EntireColumn.Delete

    ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
        Range("A1:CI" & Lastrow).SORT key1:=Range("X1:X" & Lastrow), _
            order1:=xlAscending, Header:=xlNo
        Columns("Y:FN").EntireColumn.Delete

    ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
        Range("A1:CU" & Lastrow).SORT key1:=Range("AJ1:AJ" & Lastrow), _
            order1:=xlAscending, Header:=xlNo
        Columns("AK:CU").EntireColumn.Delete

    ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
     Range("A1:CJ" & Lastrow).SORT key1:=Range("Y1:Y" & Lastrow), _
         order1:=xlAscending, Header:=xlNo
     Columns("Z:CJ").EntireColumn.Delete

    ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
     Range("A1:BZ" & Lastrow).SORT key1:=Range("O1:O" & Lastrow), _
         order1:=xlAscending, Header:=xlNo
     Columns("P:BZ").EntireColumn.Delete

    End If

    'Save flat file
    Dim strFullname As String
    Dim strFullname2 As String

    strFullname = "G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\" & Range("PB") & "\" & Format(Range("CurrentDate"), "yyyy") & "\Investments Pending Creation\" & Range("PB") & " " & Format(Range("CurrentDate"), "mmddyy") & ".csv"
    strFullname2 = "G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\" & Range("PB") & "\" & Format(Range("CurrentDate"), "yyyy") & "\Ignored\" & Range("PB") & " " & Format(Range("CurrentDate"), "mmddyy") & ".csv"

    Application.DisplayAlerts = False

    ThisWorkbook.ActiveSheet.Move
    ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
    ActiveWorkbook.Close

    ThisWorkbook.Worksheets("ignore").Copy
    ActiveWorkbook.SaveAs Filename:=strFullname2, FileFormat:=xlCSV, CreateBackup:=True
    ActiveWorkbook.Close

End If

Application.DisplayAlerts = True

Application.ScreenUpdating = True

Sheets("home").Activate

End Sub

选项显式
子原始数据（）
将CurrentDate设置为字符串
将PB设置为字符串
Dim ReturnsCheck作为字符串
将文件名设置为字符串
将MyRange设置为字符串
将aWB设置为工作簿
将tWB作为工作簿，新闻纸作为工作表
暗淡的丢失与长的相同
变暗rng As范围
暗淡单元格作为范围
以字符串形式搜索
设置tWB=ThisWorkbook
当前日期=范围（“C6”）
PB=范围（“C8”）
Application.EnableCancelKey=xlDisabled
工作表（“数据表”）。可见=真
如果tWB.工作表（“主”）范围（“PB”）=花旗银行，则
工作表（“排序区域”）。可见=真
其他工作表（“主页”）。范围（“PB”）=“潘兴”
工作表（“潘兴”）。可见=真实
ElseIf tWB.工作表（“主页”）.范围（“PB”）=“JPM”然后
工作表（“jpm”）。可见=真实
ElseIf tWB.工作表（“主页”）.范围（“PB”）=“高盛”然后
工作表（“gs”）。可见=真实
ElseIf tWB.工作表（“主页”）.范围（“PB”）=摩根士丹利
工作表（“ms”）。可见=真实
如果结束
'打开原始文件
工作簿。打开文件名：=“G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\”&Range（“PB”）和“\”格式（Range（“CurrentDate”），“yyyy”）和“\Raw Files\”和“Raw File-”&Range（“PB”）和“&Format（Range（“CurrentDate”），“mmddyy”）和“.csv”
活动工作簿。激活
设置aWB=ActiveWorkbook
如果tWB.工作表（“主”）范围（“PB”）=花旗银行，则
aWB。激活
范围（“A1”、范围（“CZ”和行数）。结束（xlUp））。复制
tWB.工作表（“排序区域”）.范围（“A1”）.粘贴特殊粘贴：=XLPasteValue
Application.CutCopyMode=False
其他工作表（“主页”）。范围（“PB”）=“潘兴”
aWB。激活
范围（“A1”，范围（“U”和行数）。结束（xlUp））。复制
tWB.工作表（“潘兴”）.范围（“A1”）.粘贴特殊粘贴：=XLPasteValue
Application.CutCopyMode=False
ElseIf tWB.工作表（“主页”）.范围（“PB”）=“JPM”然后
aWB。激活
范围（“A1”，范围（“AD”和行数）。结束（xlUp））。复制
tWB.工作表（“jpm”）.范围（“A1”）.粘贴特殊粘贴：=XLPasteValue
Application.CutCopyMode=False
ElseIf tWB.工作表（“主页”）.范围（“PB”）=“高盛”然后
aWB。激活
范围（“A1”，范围（“V”和行数）。结束（xlUp））。复制
tWB.工作表（“gs”）.范围（“A1”）.粘贴特殊粘贴：=xlPasteValues
Application.CutCopyMode=False
ElseIf tWB.工作表（“主页”）.范围（“PB”）=摩根士丹利
aWB。激活
范围（“A1”，范围（“L”和行数）。结束（xlUp））。复制
tWB.工作表（“ms”）.范围（“A1”）.粘贴特殊粘贴：=xlPasteValues
Application.CutCopyMode=False
如果结束
'关闭未保存的原始文件
aWB.Close SaveChanges:=False
“把公式抄下来
最后一排一样长
如果tWB.工作表（“主”）范围（“PB”）=花旗银行，则
工作表（“分拣区”）。激活
Lastrow=范围（“A”和Rows.Count）.End（xlUp）.Row
范围（“DB2:FN”&Lastrow）.FillDown
埃尔塞夫范围（“PB”）=“潘兴”则
工作表（“潘兴”）。激活
Lastrow=范围（“B”和Rows.Count）.End（xlUp）.Row
范围（“W2:BO”和Lastrow）。向下填充
ElseIf范围（“PB”）=“JPM”然后
工作表（“jpm”）。激活
Lastrow=范围（“A”和Rows.Count）.End（xlUp）.Row
范围（“AI2:CU”和Lastrow）。向下填充
ElseIf Range（“PB”）=当时的“高盛”
工作表（“gs”）。激活
Lastrow=范围（“A”和Rows.Count）.End（xlUp）.Row
范围（“X2:CJ”和最后一行）。向下填充
ElseIf Range（“PB”）=当时的“摩根士丹利”
工作表（“ms”）。激活
Lastrow=范围（“A”和Rows.Count）.End（xlUp）.Row
范围（“N2:BZ”和最后一行）。向下填充
如果结束
'删除被忽略的行并识别缺失的投资
作为整数的Dim n
昏暗的天空和漫长的天空一样
模糊的、长的
调光范围
设置r=ActiveSheet.UsedRange
nLastRow=最后一行-1
nFirstRow=2
长度为的尺寸i:i=1
使用ActiveSheet
出错时继续下一步
Application.ScreenUpdating=False
如果tWB.工作表（“主”）范围（“PB”）=花旗银行，则
对于n=nLastRow到nFirstRow步骤-1
如果.Cells（n，“DB”）=“忽略”，则
.Cells（n，“DB”）.EntireRow.Copy
工作表（“忽略”）。单元格（i，“A”）。粘贴特殊粘贴：=XLPasteValue
Application.CutCopyMode=False
.Cells（n，“DB”）.EntireRow.Delete
i=i+1
如果结束
下一个
埃尔塞夫范围（“PB”）=“潘兴”则
对于n=nLastRow到nFirstRow步骤-1
如果.Cells（n，“W”）=忽略，则
.Cells（n，“W”）.EntireRow.Copy
工作表（“忽略”）。单元格（i，“A”）。粘贴特殊粘贴：=XLPasteValue
Application.CutCopyMode=False
.单元格（n，“W”）.EntireRow.Delete
i=i+1
如果结束
下一个
ElseIf范围（“PB”）=“JPM”然后
对于n=nLastRow到nFirstRow步骤-1
如果.Cells（n，“AI”）=“忽略”，则
.Cells（n，“AI”）.EntireRow.Copy
工作表（“忽略”）。单元格（i，“A”）。粘贴特殊粘贴：=XLPasteValue
Application.CutCopyMode=False
.Cells（n，“AI”）.EntireRow.Delete
i=i+1
如果结束
下一个
ElseIf Range（“PB”）=当时的“高盛”
对于n=nLastRow到nFirstRow步骤-1
如果.Cells（n，“X”）=忽略，则
.Cells（n，“X”）.EntireRow.Copy
工作表（“忽略”）。单元格（i，“A”）。粘贴特殊粘贴：=XLPasteValue
Set tWB = ThisWorkbook

  With Application
    .CalculateFull
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

  With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
  End With