反向累加
Sub test()                                                   
                                                     
Dim Rng As Range                                                   
                                                     
Dim A, B, C, D, M, N, I, mRange As Integer                                                   
                                                     
If [a1] = "" Then                                                   
                                                     
    MsgBox "请先在A1单元格里输入起点单元格坐标", vbOKOnly, ""                                                   
                                                     
    Exit Sub                                                   
                                                     
End If                                                   
                                                     
Set Rng = Range([a1].Value)                                                   
                                                     
M = 1                                                   
                                                     
I = 1                                                   
                                                     
mRange = WorksheetFunction.Min(Rng.Column, Rng.Row) * 2 * (WorksheetFunction.Min(Rng.Column, Rng.Row) * 2 - 1)                                                   
                                                     
Rng = M                                                   
                                                     
Rng.Interior.Color = vbYellow                                                   
                                                     
M = M + 1                                                   
                                                     
Rng.Offset(0, 1) = M                                                   
                                                     
Rng.Offset(0, 1).Interior.Color = RGB(255 - Int(M / mRange * 255), Int(M / mRange * 255), Int(M / mRange * 255))                                                   
                                                     
Do While I < Rng.Column And I < Rng.Row                                                   
                                                     
    For A = Rng.Offset(-I, I).Column To Rng.Offset(-I, -I + 1).Column Step -1                                                   
                                                     
        M = M + 1                                                   
                                                     
        Cells(Rng.Row - I, A) = M                                                   
                                                     
        Cells(Rng.Row - I, A).Interior.Color = RGB(255 - Int(M / mRange * 255), Int(M / mRange * 255), Int(M / mRange * 255))                                                   
                                                     
    Next A                                                   
                                                     
    For B = Rng.Offset(-I, -I).Row To Rng.Offset(I - 1, -I).Row                                                   
                                                     
        M = M + 1                                                   
                                                     
        Cells(B, Rng.Column - I) = M                                                   
                                                     
        Cells(B, Rng.Column - I).Interior.Color = RGB(255 - Int(M / mRange * 255), Int(M / mRange * 255), Int(M / mRange * 255))                                                   
                                                     
    Next B                                                   
                                                     
    For C = Rng.Offset(I, -I).Column To Rng.Offset(I, I).Column                                                   
                                                     
        M = M + 1                                                   
                                                     
        Cells(Rng.Row + I, C) = M                                                   
                                                     
        Cells(Rng.Row + I, C).Interior.Color = RGB(255 - Int(M / mRange * 255), Int(M / mRange * 255), Int(M / mRange * 255))                                                   
                                                     
    Next C                                                   
                                                     
    I = I + 1                                                   
                                                     
    For D = Rng.Offset(I - 1, I).Row To Rng.Offset(-I + 1, I).Row Step -1                                                   
                                                     
        M = M + 1                                                   
                                                     
        Cells(D, Rng.Column + I) = M                                                   
                                                     
        Cells(D, Rng.Column + I).Interior.Color = RGB(255 - Int(M / mRange * 255), Int(M / mRange * 255), Int(M / mRange * 255))                                                   
                                                     
    Next D                                                   
                                                     
Loop                                                   
                                                     
End Sub