Vba 循环和IF语句花费太多时间

下面的代码假设根据一些标准在不同的工作表中执行vlookup。我声明了所有变量，它完成了它的工作，但是等待的时间太长了。我相信这是因为我有循环和两个if语句，但我看不到另一种编写两个条件（if语句）的方法。任何其他方法都必须得到赞赏。谢谢

请查看以下代码：

Private Sub CommandButton3_Click()

    Dim vlookup As Variant
    Dim lastRow As Long, lastRow1 As Long
    Dim ws As Worksheet, ws1 As Worksheet
    Dim j As Long



    Set ws = Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set ws1 = Sheets("Sheet2")
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row



    Application.ScreenUpdating = False


   For j = 2 To lastRow

    If Cells(j, "a") > 1000 And Cells(j, "b") <> "" Then

    With ws.Range("f2:f" & lastRow)
        .Formula = "=iferror(vlookup(e2, " & ws1.Range("a2:c" & lastRow1).Address(1, 1, external:=True) & ", 3, false), text(,))"
        .value = .value
    End With

    ElseIf Cells(j, "a") > 1000 Then

    With ws.Range("f2:f" & lastRow)
        .Formula = "=iferror(vlookup(d2, " & ws1.Range("a2:c" & lastRow1).Address(1, 1, external:=True) & ", 3, false), text(,))"
        .value = .value
    End With

    Else

    Cells(j, "f") = "No"


    End If

    Next

End Sub

Private子命令按钮3\u单击（）
Dim vlookup作为变体
将最后一行的长度调暗，最后一行的长度调暗
将ws设置为工作表，将ws1设置为工作表
Dim j尽可能长
设置ws=图纸（“图纸1”）
lastRow=ws.Cells（ws.Rows.Count，“A”）.End（xlUp）.Row
设置ws1=图纸（“图纸2”）
lastRow1=ws1.Cells（ws1.Rows.Count，“A”）.End（xlUp）.Row
Application.ScreenUpdating=False
对于j=2到最后一行
如果单元格（j，“a”）>1000且单元格（j，“b”）”，则
使用ws.Range（“f2:f”和lastRow）
.Formula=“=iferror（vlookup（e2）和ws1.Range（“a2:c”和lastRow1）。地址（1，1，外部：=True）和“，”3，false），文本（，）”
.value=.value
以
ElseIf细胞（j，“a”）>1000
使用ws.Range（“f2:f”和lastRow）
.Formula=“=iferror（vlookup（d2），&ws1.Range（“a2:c”和lastRow1）。地址（1，1，外部：=True）和“，3，false），文本（，）”
.value=.value
以
其他的
单元格（j，“f”）=“否”
如果结束
下一个
端接头

您正在一次又一次地将相同的公式写入和重写到相同的单元格中

Private Sub CommandButton3_Click()

    Dim r As Variant
    Dim lastRow As Long, lastRow1 As Long, j As Long
    Dim ws As Worksheet, ws1 As Worksheet, rng As Range

    Set ws = Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set ws1 = Worksheets("Sheet2")
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    Set rng = ws1.Columns(1)

    With ws
        For j = 2 To lastRow
            If .Cells(j, "a") > 1000 And .Cells(j, "b") <> "" Then
                r = Application.Match(.Cells(j, "e").Value2, rng, 0)
                If Not IsError(r) Then
                    .Cells(j, "f") = ws1.Cells(r, "c").Value
                else
                    .Cells(j, "f") = vbnullstring
                End If
            ElseIf .Cells(j, "a") > 1000 Then
                r = Application.Match(.Cells(j, "d").Value2, rng, 0)
                If Not IsError(r) Then
                    .Cells(j, "f") = ws1.Cells(r, "c").Value
                else
                    .Cells(j, "f") = vbnullstring
                End If
            Else
                .Cells(j, "f") = "No"
            End If
        Next j
    End With

End Sub

Private子命令按钮3\u单击（）
dimr作为变体
调暗最后一行的长度，最后一行1的长度，j的长度
将ws作为工作表，ws1作为工作表，rng作为范围
设置ws=工作表（“表1”）
lastRow=ws.Cells（ws.Rows.Count，“A”）.End（xlUp）.Row
设置ws1=工作表（“表2”）
lastRow1=ws1.Cells（ws1.Rows.Count，“A”）.End（xlUp）.Row
设置rng=ws1。列（1）
与ws
对于j=2到最后一行
如果.Cells（j，“a”）>1000和.Cells（j，“b”）”，则
r=应用程序匹配（.Cells（j，“e”）.值2，rng，0）
如果不是IsError（r），则
.单元（j，“f”）=ws1.单元（r，“c”）.值
其他的
.Cells（j，“f”）=vbnullstring
如果结束
ElseIf.Cells（j，“a”）>1000
r=应用程序匹配（.Cells（j，“d”）.值2，rng，0）
如果不是IsError（r），则
.单元（j，“f”）=ws1.单元（r，“c”）.值
其他的
.Cells（j，“f”）=vbnullstring
如果结束
其他的
.单元格（j，“f”）=“否”
如果结束
下一个j
以
端接头

dows单元格（j，“a”）和单元格（j，“b”）在ws（“Sheet1”）中的位置与您编写公式时单元格（j，“f”）的位置相同：您是否尝试过设置

Application.Calculation=XlCalculation.xlCalculationManual

？是的，它可以工作。谢谢你的帮助和建议。我知道公式一直在重写，但我找不到其他方法。这太完美了！谢谢你的时间！