Question

请帮忙优化VBA代码

Sub DC条件标记()
Application.ScreenUpdating = False '关闭屏幕更新
Dim N As Long
N = Sheets("日程").Range("M7") * 200
For i = 1 To N Step 200
Range(Cells(i, 2), Cells(i + 199, 2)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlBottom10Items
Range(Cells(i + 1, 2), Cells(i + 199, 2)).Interior.ColorIndex = 17
Selection.AutoFilter
Next
For i = 1 To N Step 200
Range(Cells(i, 3), Cells(i + 199, 3)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlBottom10Items
Range(Cells(i + 1, 3), Cells(i + 199, 3)).Interior.ColorIndex = 17
Selection.AutoFilter
Next
For i = 1 To N Step 200
Range(Cells(i, 10), Cells(i + 199, 10)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Percent
Range(Cells(i + 1, 10), Cells(i + 199, 10)).Interior.ColorIndex = 17
Selection.AutoFilter
Next
For i = 1 To N Step 200
Range(Cells(i, 11), Cells(i + 199, 11)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Percent
Range(Cells(i + 1, 11), Cells(i + 199, 11)).Interior.ColorIndex = 17
Selection.AutoFilter
Next
For i = 1 To N Step 200
Range(Cells(i, 15), Cells(i + 199, 15)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Percent
Range(Cells(i + 1, 15), Cells(i + 199, 15)).Interior.ColorIndex = 17
Selection.AutoFilter
Next
For i = 1 To N Step 200
Range(Cells(i, 17), Cells(i + 199, 17)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Percent
Range(Cells(i + 1, 17), Cells(i + 199, 17)).Interior.ColorIndex = 17
Selection.AutoFilter
Next
For i = 1 To N Step 200
Range(Cells(i, 24), Cells(i + 199, 24)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Percent
Range(Cells(i + 1, 24), Cells(i + 199, 24)).Interior.ColorIndex = 17
Selection.AutoFilter
Next
Application.ScreenUpdating = True
End Sub

Answer 1

Sub yueliang()
Dim N As Long
Dim i, l As Integer
Dim SearchString As String
SearchString = " 10, 11, 15, 17, 24"
N = Sheets("日程").Range("M7") * 200
Application.ScreenUpdating = False
For i = 1 To N Step 200
For l = 2 To 3
Range(Cells(i, l), Cells(i + 199, l)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlBottom10Items
Range(Cells(i + 1, l), Cells(i + 199, l)).Interior.ColorIndex = 17
Selection.AutoFilter
Next
Next

For i = 1 To N Step 200
For l = 10 To 24
If InStr(SearchString, Str(l)) > 0 Then
Range(Cells(i, l), Cells(i + 199, l)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="10", Operator:=xlTop10Percent
Range(Cells(i + 1, l), Cells(i + 199, l)).Interior.ColorIndex = 17
Selection.AutoFilter
End If
Next
Next
Application.ScreenUpdating = True
End Sub