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

时间:2018-05-15 10:44:45

标签: vba excel-vba excel

下面的代码假设根据某些标准在不同的工作表中执行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

1 个答案:

答案 0 :(得分:1)

您正在反复编写相同的公式并将其重写到相同的单元格中。

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