Question

我想创建一个宏，它将在另一个工作表中进行vlookup，并通过另一个用户定义的值更改vlook up单元格中的值。

我写了一个非常基本的代码，完全满足了我的需求，但它非常慢，一次运行大约需要3分钟。

您能否建议一个更简单的方法或只是建议我的代码有什么问题。

Private Sub CommandButton1_Click()

    Dim myCell As Range
    Dim myLookup
    Dim i As Integer
    i = Sheets("Modify Order").Cells(5, 2).Value
     For Each myCell In Sheets("Customer List").Range("E:E")
         If myCell.Value = Sheets("Modify Order").Cells(4, 2).Value Then
         myCell.Offset(0, i).Value = Sheets("Modify Order").Cells(7, 2).Value
         End If
        Next myCell

MsgBox "Done!"
End Sub

Answer 1

逐个单元迭代总是很慢：更好地使用变体数组：

Sub CommandButton1_Click()

Dim vArrColE As Variant
Dim vArrColChange As Variant
Dim myLookup As Variant
Dim myChangeTo As Variant
Dim j As Long
Dim jLastRow As Long
Dim kCol As Long
Dim nChanged As Long
Dim lCalc As Long

lCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

myLookup = Sheets("Modify Order").Cells(4, 2).Value2
myChangeTo = Sheets("Modify Order").Cells(7, 2).Value2
kCol = Sheets("Modify Order").Cells(5, 2).Value2
jLastRow = Sheets("Customer List").Cells(Rows.Count, 5).End(xlUp).Row
'
' get columns into variant arrays
'
vArrColE = Sheets("Customer List").Range("E1:E" & jLastRow).Value2
vArrColChange = Sheets("Customer List").Cells(1, kCol).Resize(jLastRow, 1).Value2

For j = LBound(vArrColE) To UBound(vArrColE)
    If vArrColE(j, 1) = myLookup Then
        vArrColChange(j, 1) = myChangeTo
        nChanged = nChanged + 1
    End If
Next j
'
' put changed column back
'
Sheets("Customer List").Cells(1, kCol).Resize(jLastRow, 1).Value2 = vArrColChange

Application.Calculation = lCalc
MsgBox "Changed " & nChanged & " Cells"
End Sub

Answer 2

我使用AutoFilter()：

Option Explicit

Private Sub CommandButton1_Click()
    Dim myLookup As Variant
    Dim i As Integer

    With Sheets("Modify Order")
        i = .Cells(5, 2).Value
        myLookup = .Cells(4, 2).Value
    End With
    With Sheets("Customer List")
        With .Range("E1", .Cells(.Rows.count, "E").End(xlUp))
            .AutoFilter Field:=1, Criteria1:=myLookup
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .Offset(1, i).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible).Value = Sheets("Modify Order").Cells(7, 2).Value
        End With
        .AutoFilterMode = False
    End With

    MsgBox "Done!"
End Sub

vlookup和replace - 性能改进

2 个答案: