根據另一個單元格的值更新一系列單元格

Question

我非常新，所以請耐心等待。 我想評估C5：BM5范圍內的每個細胞。 如果該范圍中的任何單元格=“HOLIDAY”或“SUN”，則需要清除該列中的第7-19行。 我拼湊了下面的代碼，它做了我需要的，它只是非常緩慢。 我知道必須有更好的方法。 尋找一些聰明的建議。

Sub HolidayUpdate()

Dim Cell As Range

For Each Cell In Sheets("Production Calendar").Range("C5:BM5")

If Cell = "HOLIDAY" Then
Cell.Offset(2, 0).ClearContents
Cell.Offset(3, 0).ClearContents
Cell.Offset(4, 0).ClearContents
Cell.Offset(5, 0).ClearContents
Cell.Offset(6, 0).ClearContents
Cell.Offset(7, 0).ClearContents
Cell.Offset(8, 0).ClearContents
Cell.Offset(9, 0).ClearContents
Cell.Offset(10, 0).ClearContents
Cell.Offset(11, 0).ClearContents
Cell.Offset(12, 0).ClearContents
Cell.Offset(13, 0).ClearContents
Cell.Offset(14, 0).ClearContents
ElseIf Cell = "SUN" Then
Cell.Offset(2, 0).ClearContents
Cell.Offset(3, 0).ClearContents
Cell.Offset(4, 0).ClearContents
Cell.Offset(5, 0).ClearContents
Cell.Offset(6, 0).ClearContents
Cell.Offset(7, 0).ClearContents
Cell.Offset(8, 0).ClearContents
Cell.Offset(9, 0).ClearContents
Cell.Offset(10, 0).ClearContents
Cell.Offset(11, 0).ClearContents
Cell.Offset(12, 0).ClearContents
Cell.Offset(13, 0).ClearContents
Cell.Offset(14, 0).ClearContents
End If

Next Cell

End Sub

Answer 1

1. 你可以結合你所有的補償。
2. 您可以禁用計算和屏幕更新。

3. 這是您的代碼的更新。

    Sub HolidayUpdate() Dim rgCell As Range application.screenupdating=false application.calculation=xlcalculationmanual For Each rgCell In Sheets("Production Calendar").Range("C5:BM5") If rgCell = "HOLIDAY" OR rgCell = "SUN" _ Then rgCell.Offset(2, 0).resize(13).ClearContents Next rgCell application.screenupdating=true application.calculation=xlCalculationAutomatic End Sub