Более эффективная альтернатива для каждого

Question

Я пытаюсь получить более быстрый и эффективный код, чем этот, так как диапазон со временем значительно увеличится, поэтому мне нужно будет заменить For Each.

Макрос будет искать значение " Понедельник "через каждую ячейку столбца и, если он найден, он вернет значение" Substract "в предыдущей ячейке в столбце A.

Sub ForEachTest()

Dim Rng As Range

Set Rng = Range("B3:B1000")

For Each cell In Rng

  If cell.Value = "Monday" Then
     cell.Offset(0, -1) = "Substract"
  End If

Next cell

End Sub

Answer 1

L oop в VBA, а не на рабочем листе:

Sub faster()
    Dim arr()

    arr = Range("A3:B1000")

    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, 2) = "Monday" Then arr(i, 1) = "Substract"
    Next i

    Range("A3:B1000") = arr
End Sub

РЕДАКТИРОВАНИЕ № 1:

Эта версия относится к озабоченности BigBen о том, что столбец B не следует перезаписывать, чтобы сохранить какие-либо формулы в этом столбце. Здесь перезаписывается только столбец A :

Sub faster2()
    Dim arr(), brr()

    arr = Range("A3:A1000")
    brr = Range("B3:B1000")

    For i = LBound(brr, 1) To UBound(brr, 1)
        If brr(i, 1) = "Monday" Then arr(i, 1) = "Substract"
    Next i

    Range("A3:A1000") = arr
End Sub

Answer 2

Вы можете избежать l oop, отфильтровав свои данные и работая с результирующим видимым набором данных.

Это только изменит ячейки в Column A когда Column B = Monday. Все остальные ячейки остаются как есть

---

Sub Shelter_In_Place()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
lr As Long

lr = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
ws.Range("A1:B" & lr).AutoFilter Field:=2, Criteria1:="Monday"
ws.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).Value = "Subtract"

ws.AutoFilterMode = False

End Sub

Answer 3

Попробуйте использовать Evaluate

Sub Test()
With Range("A3:A" & Cells(Rows.Count, 2).End(xlUp).Row)
    .Value = Evaluate("IF(" & .Offset(, 1).Address & "=""Monday"",""Substract"","""")")
End With
End Sub