根据另一个单元格的值更新一系列单元格

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