利用VBA填充螺旋数

最近在QQ上，有个朋友问一个比较有趣的问题，怎么在Excel中填充类似下面表格的数列：

想了一下，还是用VBA来完成，首先选择要填充的数据区域，再运行下面的宏：

Sub 填螺旋数()
Dim XR As Range, YR As Range, TR As Range
Dim N As Integer, I As Integer, T As Integer
Dim X1 As Integer, X2 As Integer, Y1 As Integer, Y2 As Integer
If TypeName(Selection) = "Range" Then
    If Selection.Areas.Count = 1 Then
        Set XR = Selection
    Else
        Set XR = Selection.Areas(1)
    End If
    XR.Clear
    With XR
        N = .Count
        X1 = .Item(1).Column
        Y1 = .Item(1).Row
        X2 = .Item(N).Column
        Y2 = .Item(N).Row
        Set YR = .Item(1)
    End With
    YR = 1
    T = 1
    I = 2
    On Error Resume Next
    Application.ScreenUpdating = False
    Do
        Select Case T
        Case 1
            Set TR = YR.Offset(0, 1)
            If TR.Column > X2 Or Len(TR) > 0 Then
                I = I - 1
                T = T + 1
            Else
                Set YR = TR
                YR = I
            End If
        Case 2
            Set TR = YR.Offset(1, 0)
            If TR.Row > Y2 Or Len(TR) > 0 Then
                I = I - 1
                T = T + 1
            Else
                Set YR = TR
                YR = I
            End If
        Case 3
            Set TR = YR.Offset(0, -1)
            If TR.Column < X1 Or Len(TR) > 0 Then
                I = I - 1
                T = T + 1
            Else
                Set YR = TR
                YR = I
            End If
        Case 4
            Set TR = YR.Offset(-1, 0)
            If TR.Row < Y1 Or Len(TR) > 0 Then
                I = I - 1
                T = T + 1
            Else
                Set YR = TR
                YR = I
            End If
        End Select
        If T > 4 Then T = T - 4
        I = I + 1
    Loop While I <= N
    Application.ScreenUpdating = True
Else
    MsgBox "选择的内容包含非单元格区域！", , "http://www.excelba.com"
End If
End Sub