如何优化Excel VBA代码

华金

如何优化此代码？执行需要很多时间。

执行时间

它的作用：将一个范围内的一个单元格列表与另一个范围内的另一个单元格列表进行比较，如果它们匹配，它将用另一个范围内的第二个值的相邻值替换第一个范围的第一个值。

注意：这是一个将在2000-5000行上运行的宏。

Sub Update_Btn()
    Application.ScreenUpdating = False
    Application.Cursor = xlWait

    Dim status As Range, r_status As Range, l_status As Range, rl_status As Range

    lastRowcs = Worksheets("Lists").Range("E" & Rows.Count).End(xlUp).Row
    Set status = Range("D2:D" & lastRow)
    Set l_status = Worksheets("Lists").Range("E3:E" & lastRowcs)

    For Each r_status In status
        For Each rl_status In l_status
            If r_status.Value = rl_status.Value Then
                rl_status.Offset(0, 1).Copy r_status
            End If
        Next rl_status
    Next r_status

    MsgBox "Done"

    Application.Cursor = xlDefault
    Application.ScreenUpdating = True
Exit Sub

保罗·比卡

使用数组- Sheet "GB_Data" Rows: 5,001; Sheet "Lists" Rows: 5,001; Time: 6.438 sec

Option Explicit

Public Sub UpdateBtn()

    Const WS1_NAME = "GB_Data"
    Const WS2_NAME = "Lists"

    Const START_ROW1 = 2    'in GB_Data
    Const START_ROW2 = 2    'in Lists

    Const COL1 = "D"        'in GB_Data
    Const COL2 = "E"        'in Lists
    Const COL3 = "F"        'in Lists

    Dim ws1 As Worksheet:   Set ws1 = ThisWorkbook.Worksheets(WS1_NAME)
    Dim ws2 As Worksheet:   Set ws2 = ThisWorkbook.Worksheets(WS2_NAME)
    Dim lr1 As Long:        lr1 = ws1.Cells(ws1.Rows.Count, COL1).End(xlUp).Row
    Dim lr2 As Long:        lr2 = ws2.Cells(ws2.Rows.Count, COL2).End(xlUp).Row
    Dim arr1 As Variant:    arr1 = ws1.Range(COL1 & START_ROW1 & ":" & COL1 & lr1).Formula
    Dim arr2 As Variant:    arr2 = ws2.Range(COL2 & START_ROW2 & ":" & COL3 & lr2).Formula

    Dim r1 As Long, r2 As Long

    For r1 = 1 To UBound(arr1)
        For r2 = 1 To UBound(arr2)
            If arr1(r1, 1) = arr2(r2, 1) Then arr1(r1, 1) = arr2(r2, 2)
        Next r2
    Next r1
    ws1.Range(COL1 & START_ROW1 & ":" & COL1 & lr1).Formula = arr1
End Sub

。

测试数据

工作表“ GB_Data”-之前