­ã´£³¡ª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

­ã´£³¡ªL

¦^´_ 4# ziv976688

¬Q¤Ñ¥^¥^°µ, ¥¼¦A¼f¹î, ­×¥¿¤@¤U:
For j = r To r - 3 Step -1  >>> 3 §ï¦¨ 2 ¤~¹ï

­ã´£³¡ªL

¦^´_ 9# ziv976688

Sub ¼Ð¥Ü©³¦â()
Dim r&, c&, k%, Km, U&, xE As Range
If IsDate([A2]) = False Then Exit Sub
r = [A1].End(xlDown).Row
c = [A1].End(xlToRight).Column
Km = Array("", 40, 39, 38)
Range([B2], Cells(r, c)).Interior.ColorIndex = 0
U = r - 2: If U > 2 Then U = 2
For i = 2 To c
    k = 0: Set xE = Cells(r, i)
For j = r To r - U 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