2017-02-08 2 views
0

Я хочу создать макрос, который будет vlookup на другом листе, и изменить значение в ячейке vlook вверх другим значением, определенным пользователем.vlookup и replace - повышение производительности

Я написал очень простой код, который заполняет мои потребности, но он очень медленный, и его запуск занимает почти 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 
+0

Сколько строк сделать вас есть в колонке E? Вы можете попытаться найти последнюю строку, которая содержит данные, прежде чем вы начнете цикл for, чтобы не тратить время на проверку ячеек, которые не содержат никаких данных. –

+0

Попробуйте добавить эти две строки и скажите, улучшится ли это. 'LastRow = Таблицы (« Список клиентов »). Ячейки (Rows.Count, 5) .End (xlUp) .Row' ' Для каждого myCell In Sheets («Список клиентов»). Диапазон («E1: E») & LastRow & "") ' –

+0

Может быть лучше [CodeReview] (http://codereview.stackexchange.com/questions/tagged/vba?sort=newest&pageSize=50) –

ответ

0

Я хотел бы использовать 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 
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