vlookupとreplace - パフォーマンスの向上

Question

別のシートでvlookupし、別のユーザー定義の値でvlook upセルの値を変更するマクロを作成したいとします。

私は自分の必要性を満たしている非常に基本的なコードを書いたが、それは非常に遅く、1回の実行にはほぼ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

私は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 

Answer 2

それは常に非常に遅い反復セル・バイ・セル：

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