Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 4797|回复: 12

[已解决]VBA如何实现有规律数字自动填充从A1开始

[复制链接]
发表于 2016-3-8 14:03 | 显示全部楼层 |阅读模式

单元格A1从0开始,如图规律走法,一直走到90

用VBA如何实现




最佳答案
2016-3-9 09:06
Sub test()
    Dim n, A(), j

    n = 90
    ReDim A(1 To 2, 1 To n / 2)
    A(1, 1) = 0
    A(2, 1) = 1

    For j = 2 To UBound(A, 2)
        A(1, j) = A(2, j - 1) + 2
        A(2, j) = A(1, j - 1) + 2
    Next j
    [a1].Resize(2, UBound(A, 2)) = A
End Sub


VBA如何实现有规律数字自动填充从A1开始.jpg
发表于 2016-3-8 14:15 | 显示全部楼层
本帖最后由 gufengaoyue 于 2016-3-8 14:23 编辑
  1. Sub TEST()
  2. Dim arr, x%, a%, Rng As Range
  3. [a1] = 0: arr = [{1,0;0,1;-1,0;0,1}]
  4. Set Rng = [a1]
  5. For a = 1 To 90
  6.      x = ((a - 1) Mod 4) + 1
  7.      Set Rng = Rng.Offset(arr(x, 1), arr(x, 2))
  8.      Rng = a
  9. Next
  10. End Sub
复制代码

评分

参与人数 1 +6 收起 理由
vbyou127 + 6 来学习

查看全部评分

回复

使用道具 举报

发表于 2016-3-8 14:32 | 显示全部楼层
  1. Sub tt()
  2.     Dim arr(), N
  3.     N = 90
  4.     ReDim arr(1 To 2, 1 To N / 2)
  5.     a = 1: b = 1
  6.     For i = 1 To N
  7.         arr(a, b) = i
  8.         If (a + b) Mod 2 = 1 Then
  9.             b = b + 1
  10.         Else
  11.             a = IIf(a = 1, 2, 1)
  12.         End If
  13.     Next
  14.     [a1].Resize(2, N / 2) = arr
  15. End Sub
复制代码

评分

参与人数 1 +6 收起 理由
vbyou127 + 6 来学习

查看全部评分

回复

使用道具 举报

发表于 2016-3-8 14:46 | 显示全部楼层
本帖最后由 sry660 于 2016-3-8 14:50 编辑
  1. Sub 填充数据()
  2.     Dim arr, i&, j&
  3.     ReDim arr(1 To 2, 1 To 46)
  4.     For i = 1 To 2
  5.         For j = 1 To 46
  6.             arr(i, j) = i - 1 + (j - 1) * 2
  7.         Next
  8.     Next
  9.     arr(2, 46) = ""
  10.     Cells.Clear
  11.     [a1].Resize(2, 46) = arr
  12.     [a:at].EntireColumn.AutoFit
  13. End Sub
复制代码

按要求填充数据.rar

14.59 KB, 下载次数: 6

评分

参与人数 1 +6 收起 理由
vbyou127 + 6 来学习

查看全部评分

回复

使用道具 举报

发表于 2016-3-8 15:12 | 显示全部楼层
  1. Sub test()
  2.     For i = 0 To 1
  3.         For j = i To 90 Step 4
  4.             n = n + 1
  5.             If (i = 0) * (n = 3) Then n = n - 1: j = j - 1
  6.             Cells(i + 1, n) = j
  7.             n = n + 1
  8.             Cells(i + 1, n) = j + 1
  9.         Next
  10.         n = 0
  11.     Next
  12. End Sub
复制代码

评分

参与人数 1 +6 收起 理由
vbyou127 + 6 来学习

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-3-8 16:49 | 显示全部楼层
雪舞子 发表于 2016-3-8 15:12

作个标志明天再来加分,
回复

使用道具 举报

发表于 2016-3-9 09:06 | 显示全部楼层    本楼为最佳答案   
Sub test()
    Dim n, A(), j

    n = 90
    ReDim A(1 To 2, 1 To n / 2)
    A(1, 1) = 0
    A(2, 1) = 1

    For j = 2 To UBound(A, 2)
        A(1, j) = A(2, j - 1) + 2
        A(2, j) = A(1, j - 1) + 2
    Next j
    [a1].Resize(2, UBound(A, 2)) = A
End Sub


评分

参与人数 1 +6 收起 理由
vbyou127 + 6 来学习

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-3-9 09:12 | 显示全部楼层
爱疯 发表于 2016-3-9 09:06
Sub test()
    Dim n, A(), j

几个答案没有认真去看
回复

使用道具 举报

发表于 2016-3-9 11:22 | 显示全部楼层
点评一下:

本帖楼主要求的,是典型的【蛇行数列填充】问题。
即,以固定行数H(或列数L)[本例H=2]作为填充方向转折点,
按奇、偶数的列(或行)不同,进行升序/降序填充连续数字得到Z形蛇行数列。


各楼回帖代码简评如下:

一、2楼【gufengaoyue】的代码,典型的参数法。
    以行、列的演化规律即步长为每4个数的规律变化值,作为参数 [{1,0;0,1;-1,0;0,1}]
    此法代码简单,但适应性略差。如要求改变则需改动参数甚至调整步长。

二、3楼【grf1973】的代码,是参数特征法。
   以每2行增加1列作为列变化参数、去触发行变化。
   此法比较精巧、构思有难度。但无适应性。(蛇行的行数增大时,难以继续)

        代码转换逻辑解析:
        If (i + j) Mod 2 Then '当行数i+列数j为奇数时 进入Z点即转折点进入下一列
            j = j + 1    '列数j+1进行转折 进入下一列
           'i = i          '进入下一列后行数i 维持不变 因此此句可省略
        Else '否则不转折 但行位置要进行1/2交换。
            'j = j         '不转折时维持列数j不变 因此此句可省略
            If i = 1 Then i = 2 Else i = 1 '行位置进行1、2交替
        End If
  总之,这个逻辑构思是值得赞赏的。

三、4楼【sry660】的代码,是直接循环法,利用循环参数进行填充。
    但遗憾的是,对楼主要求的蛇行数列认识不足,得到的结果是错误的。


    For i = 1 To 2 '行数循环1-2
        For j = 1 To 46 '列数递增
            arr(i, j) = i - 1 + (j - 1) * 2 '填充结果错误,仅得到第1行偶数、第2行奇数的结果。
        Next
    Next

四、5楼【雪舞子】的代码,是直接循环法,利用循环参数以及步长=4进行填充。
     唯一的特异点时:第1行第2列必须单独设置为=3
     相当于规定了1、2、3、4这4个点的起始值
     0、3
     1、2
     然后以步长=4进行填充。

呵呵。本法无普遍适应性。

五、7楼【爱疯】的代码,也是直接循环法,利用循环步长=2进行每次2行的填充。
     巧妙的是,每次填充利用了对角+2的算法。

本法也无普遍适应性。


呵呵。

评分

参与人数 2 +12 收起 理由
vbyou127 + 6 来学习
gufengaoyue + 6 赞一个

查看全部评分

回复

使用道具 举报

发表于 2016-3-9 11:56 | 显示全部楼层
最具有通用性的蛇行数列代码:
  1. Sub 蛇行() ' by kagawa
  2.     Dim ar, i&, i1&, i2&, j&, H&, L&, m&, n&, S&
  3.     n = 0 '起始值n
  4.     m = 90 '结束值m
  5.     H = 3   '转折行数H (可任意设置)

  6.     [a1].CurrentRegion = "" '清空输出区域

  7.     L = (m - n) \ H + 1 '计算展开需要最大列数L
  8.     ReDim ar(1 To H, 1 To L) '定义存放结果的二维数组ar

  9.     For j = 1 To L '按列循环
  10.         If j Mod 2 Then i1 = 1: i2 = H: S = 1 Else i1 = H: i2 = 1: S = -1
  11.         '设置行循环参数:奇数列升序、偶数列降序
  12.         For i = i1 To i2 Step S
  13.             Cells(i, j) = n '直接输出到工作表
  14.             ar(i, j) = n    '或写入数组ar
  15.             n = n + 1: If n > m Then Exit For '到结束值m时退出循环
  16.         Next
  17.     Next
  18.     [a1].Resize(H, L) = ar '输出数组结果到工作表
  19. End Sub
复制代码
这样的蛇行数列展开代码,就可以处理任意转折行数了。

仅需更改Cells(i, j) = n 为Cells(j, i) = n 即可得到行列转置后的结果。

评分

参与人数 1 +6 收起 理由
gufengaoyue + 6 很给力

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 19:59 , Processed in 1.575346 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表