Excel实例下载
  VBA  应用教程
    数据库SQL知识
设为首页
利用VBA填充螺旋数
作者:bengdeng | 来源:Excel吧 | 时间:2007-04-04 | 阅读权限:游客 | 会员币:0 | 【

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

1 2 3 4 5 6 7 8 9 10
36 37 38 39 40 41 42 43 44 11
35 64 65 66 67 68 69 70 45 12
34 63 84 85 86 87 88 71 46 13
33 62 83 96 97 98 89 72 47 14
32 61 82 95 100 99 90 73 48 15
31 60 81 94 93 92 91 74 49 16
30 59 80 79 78 77 76 75 50 17
29 58 57 56 55 54 53 52 51 18
28 27 26 25 24 23 22 21 20 19

想了一下,还是用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

文章录入:admin | 浏览次数:
相关评论(以下网友评论只代表其个人观点,不代表Excel吧的观点或立场)
相关信息

关于本站 | 留言本站 | 友情连接 | 后台管理
Copyright © 2005 - 2008 Excel吧 Inc. All Rights Reserved.
HxCms Ver9.0  闽ICP备06001689号
关闭此窗口