ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 3954|回复: 9

[原创] 蛇形矩阵 螺旋矩阵_自定义函数

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-4-3 00:22 | 显示全部楼层 |阅读模式
本帖最后由 yjh_27 于 2014-4-3 12:48 编辑

按 指定行列数 返回所需矩阵

蛇形矩阵 螺旋矩阵.rar

35.53 KB, 下载次数: 148

更新

TA的精华主题

TA的得分主题

发表于 2014-4-3 08:50 | 显示全部楼层
虽然楼主自己的代码是原创,但这个问题前几天刚刚被讨论过:
http://club.excelhome.net/forum. ... p;page=3#pid7547608

据我阶段性总结螺旋矩阵算法就有三种:
① 边界条件改变Case 或ElseIf 递增算法
  直线循环赋值,判断到达边界时改变直线方向。
  
  赋值有4个方向Case、边界改变处理也有4个Case
  所以代码简单却比较繁琐。

② 计算直线步长,改用For 循环赋值并按规律改变直线向
  行增量、列增量规律= Array(0, 1, 0, -1)
  
   本质上和赋值和上面算法类似,但边界条件改变的计算会比较高效。


③ 四角同时推进算法
  由外向里每一层(圈)计算起点值和步长然后For循环赋值。
  最后的内圈也根据计算单独完成。

  这个算法是效率最高的。

  也是最有技术含量的(需要真正的计算)


点评

想回帖时,找不到了,所以开新贴  发表于 2014-4-3 12:50

TA的精华主题

TA的得分主题

发表于 2014-4-3 08:56 | 显示全部楼层
至于螺旋矩阵的顺时针或逆时针方向性……

本质上只有一种,即:
顺时针 xy矩阵,相当于逆时针yx矩阵的【行列转置结果】。
逆时针 xy矩阵,相当于顺时针yx矩阵的【行列转置结果】。

注意 x 、y 要做交换。(如果x=y是正方形则一样。)



逆时针 x、y矩阵,相当于顺时针y、x矩阵的【行列转置结果】。

TA的精华主题

TA的得分主题

发表于 2014-4-3 09:15 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
楼主算法确实也是创新。

由外及里推进每一层的Do循环、
计算4方向各种参数、然后Case 赋值。

…………
不过,总感觉是更加繁琐的做法。




TA的精华主题

TA的得分主题

发表于 2014-4-3 12:02 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 香川群子 于 2014-4-3 14:44 编辑

我的第3种算法代码:

  1. Sub test3() '测试并输出
  2.     Dim x&, y&
  3.     x = [x1]: y = [y1] '工作表单元格参数赋值
  4.     'x = 5: y = 8 '或直接赋值测试
  5.     [a1].Resize(x * 2 + 2, y + 2) = 1: [a1].CurrentRegion = "" '清空数据区域
  6.     [a1].Resize(x, y) = luoxuan(x, y) '输出顺时针螺旋矩阵
  7.     [a1].Offset(x + 2).Resize(x, y) = luoxuan(x, y, 1) '输出逆时针螺旋矩阵
  8. End Sub

  9. Function luoxuan(ByVal x&, ByVal y&, Optional z& = 0)
  10.     Dim i&, j&, n&, r1&, c1&, k1&, r2&, c2&, k2&
  11.     If z Then n = x: x = y: y = n '如果是逆时针要求 则x、y交换

  12.     ReDim a&(1 To x, 1 To y)
  13.     If x < y Then n = x Else n = y '确定层数n为x、y中的最小值
  14.     r1 = 1: c1 = 1: k1 = 1 '左上角起点行r1、列c1位置以及写入序号k1的初始化
  15.     r2 = x: c2 = y: k2 = k1 + x + y - 2 '右下角起点行r2、列c2位置以及写入序号k2的初始化
  16.     For i = 2 To n Step 2 '层数按步长2循环 (每循环一层能去掉2行 或2列)
  17.         For j = 0 To c2 - c1 - 1 '上行r1和下行r2 按列数差c2-c1循环
  18.             a(r1, c1 + j) = k1 + j '上行r1逐列递增c1+j 写入k1+j
  19.             a(r2, c2 - j) = k2 + j '下行r2逐列递减c2-j 写入k2+j
  20.         Next
  21.         k1 = k1 + j: k2 = k2 + j '更新当前的k1 和 k2值

  22.         For j = 0 To r2 - r1 - 1 '右列c2和左列c1 按行数差r2-r1循环
  23.             a(r1 + j, c2) = k1 + j '右列c2逐行递增r1+j 写入k1+j (注意此时k1已经更新)
  24.             a(r2 - j, c1) = k2 + j '左列c1逐行递减r2-j 写入k2+j (注意此时k2已经更新)
  25.         Next
  26.         k1 = k2 + j '更新下一层的左上起点k1值 (最后的左列值+1)
  27.      k2 = k1 + (x - 1 - i) + (y - 1 - i) '更新下一层的右下起点k2值 (按新的k1值计算 并加上x、y方向增量)
  28.         r1 = r1 + 1: c1 = c1 + 1 '更新左上起点位置r1、c1
  29.         r2 = r2 - 1: c2 = c2 - 1 '更新右下起点位置r2、c2
  30.     Next
  31.     '上述整数层循环写入完成后 如果是奇数则还剩一行或一列待填写
  32.     If n Mod 2 Then '判断是否奇数层
  33.         If x < y Then '如果行x小于列y
  34.             For j = 0 To c2 - c1 '则新的r1行循环各列
  35.                 a(r1, c1 + j) = k1 + j
  36.             Next
  37.         Else '行x大于或等于列y时
  38.             For j = 0 To r2 - r1'则新的c2列循环各行
  39.                 a(r1 + j, c2) = k1 + j
  40.             Next
  41.         End If
  42.     End If
  43.    
  44.     If z Then luoxuan = Application.Transpose(a) Else luoxuan = a
  45.     '如果要求逆时针则需要对结果数组进行 行列转置
  46. End Function
复制代码
呵呵,简单明了。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-4-3 12:31 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-4-3 13:56 | 显示全部楼层
下面这个才算是工作表中也能使用的自定义函数:

根据螺旋矩阵参数,计算返回序列k的行、列位置。
  1. Function wz(ByVal k&, ByVal x&, ByVal y&, Optional z& = 0)
  2.     Dim n&, r&, t
  3.     If z Then r = x: x = y: y = r '逆时针要求时x、y交换
  4.    
  5.     r = (x + y) * 2 - 4 '计算第一层个数
  6.     Do Until k < r + 1 '迭代计算直到k序号的所在层
  7.         k = k - r '剩余个数k
  8.         r = r - 8 '下一层减去8
  9.         n = n + 1 '层数累计
  10.     Loop
  11.     x = x - 1 - n * 2: y = y - 1 - n * 2 '该层的x、y实际长度
  12.     If k < y + 1 Then '最上行
  13.         t = Array(n + 1, n + k)
  14.     ElseIf k < y + x + 1 Then '最右列
  15.         t = Array(n + k - y, y + n + 1)
  16.     ElseIf k < y + x + y + 1 Then '最下行
  17.         t = Array(x + n + 1, y + n - (k - y - x) + 2)
  18.     Else '最左列
  19.         t = Array(x + n - (k - y - x - y) + 2, n + 1)
  20.     End If
  21. '    If z Then wz = Array(t(1), t(0)) Else wz = t '按数组输出矩阵坐标
  22.     If z Then wz = Join(Array(t(1), t(0)), "-") Else wz = Join(t, ",") '或输出字符串结果
  23. End Function
复制代码

TA的精华主题

TA的得分主题

发表于 2014-4-3 14:49 | 显示全部楼层
下一步准备写代码,从中心开始赋值。

这样的螺旋方向,和从1,1位置开始由外向里螺旋是相反的。

即由外向里的顺时针螺旋、相当于中心开始向外的逆时针螺旋。
而由外向里的逆时针螺旋、相当于中心开始向外的顺时针螺旋。

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-4-3 16:03 | 显示全部楼层
yinxingbaoshu 发表于 2014-4-3 12:31
这个代码,作何用呢?

按 指定行列数 返回所需矩阵

应用见附件

蛇形矩阵 螺旋矩阵.rar

37.94 KB, 下载次数: 130

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-4-3 16:14 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 yjh_27 于 2014-4-3 16:27 编辑
香川群子 发表于 2014-4-3 14:49
下一步准备写代码,从中心开始赋值。

这样的螺旋方向,和从1,1位置开始由外向里螺旋是相反的。

原代码可用
值可以这样处理:
由外向里 :n0=0:n1=1
由里向外 :n0=x*Y+1:n1=-1

值=n0+n1*原值   

方向按你说的

位置函数同样:k值=(输入k值-n0)*n1
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-24 03:15 , Processed in 0.049375 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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