­ã´£³¡ªL

Sub ¼Ð¥Ü©³¦â()
Dim r&, c&, k%, Km, xE As Range
r = [a1].End(xlDown).Row
c = [a1].End(xlToRight).Column
Km = Array("", 40, 39, 38)
Range([B2], Cells(r, c)).Interior.ColorIndex = 0
For i = 2 To c
    k = 0: Set xE = Cells(r, i)
For j = r To r - 2 Step -1
    If Cells(j, i) = "" Then Exit For Else k = k + 1
Next
    If k > 0 Then xE(-k + 2).Resize(k).Interior.ColorIndex = Km(k)
Next
End Sub