20190104xlVBA_在课表里标记课程

Sub TagMyCourses()
    Const HEAD_ROW = 3
    With ActiveSheet
        endrow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
        endcol = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
        For j = 1 To endcol
            If IsInArray(.Cells(HEAD_ROW, j).Value) Then
                For i = HEAD_ROW To endrow
                    If .Cells(i, j).Value Like "*地*" Then
                        FillPink (.Cells(i, j))
                    End If
                Next i
            End If
        Next j
    End With
End Sub
Private Function IsInArray(ByVal i As Variant) As Boolean
    IsInArray = False
    For Each ele In Array(4, 5, 7, 11, 12, 14) '自己教授的班级
        If ele = i Then
            IsInArray = True
            Exit For
        End If
    Next ele
End Function
Private Sub FillPink(ByVal rng As Range)
    With rng.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16711935
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub