根据列A中的文本清除特定的单元格区域

我需要清除列A中具有“实际”一词的行中的特定单元格区域。我一直在尝试使用以下代码,但是它非常慢,因为它需要通过三个IF语句处理以清除不连续范围B:E,I:J,N:O。 有没有人有如何将三个if语句合并成一个语句的想法,和/或提供如何加快这个代码的想法? 谢谢您的考虑。

Sub ClearWeeklyActualPHSR() Dim lr As Long, i As Long 'Purpuse: clears specific cell ranges if column A = "Actual" Application.ScreenUpdating = False 'Disable screen refresh Application.Calculation = xlCalculationManual 'Switch calculation mode to manual (speeds up calculation) 'Counts number of rows in column A lr = Sheets("Actual Data").Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lr 'If "Actual" in column A, then clear contents of columns B:E,I:J,N:O for those rows. If Sheets("Actual Data").Cells(i, "A") = "Actual" Then Cells(i, "B").Resize(1, 4).ClearContents Cells(i, "I").Resize(1, 2).ClearContents Cells(i, "N").Resize(1, 2).ClearContents Next i Application.ScreenUpdating = True 'Enable Auto calculation Application.Calculation = xlCalculationAutomatic 'Switch calculation mode back to auto End Sub 

这是未经testing的 ,但可以作为模板:

 Sub ClearWeeklyActualPHSR() Dim lr As Long, i As Long 'Purpuse: clears specific cell ranges if column A = "Actual" - SUB is SLOW Application.ScreenUpdating = False 'Disable screen refresh Application.Calculation = xlCalculationManual 'Switch calculation mode to manual (speeds up calculation) 'Counts number of rows in column A With Sheets("Actual Data") lr = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lr 'If "Actual" in column A, then clear contents of columns B:E,I:J,N:O for those rows. If .Cells(i, "A") = "Actual" Then Union(.Cells(i, "B").Resize(1, 4), .Cells(i, "I").Resize(1, 2), .Cells(i, "N").Resize(1, 2)).ClearContents End If Next i End With Application.ScreenUpdating = True 'Enable Auto calculation Application.Calculation = xlCalculationAutomatic 'Switch calculation mode back to auto End Sub