玩一玩简单的分形：谢尔宾斯基三角形

aoe1981

我做的效果图如下：









代码很简单：

1. Option Explicit
   
2. Public Sub FXSJ_sjd()
   
3.     Dim abc, M, pc, ds&, arr%(), i&, j&, k&, SJD#(), r%
   
4.     Range("e2").Resize(1000000, 3).ClearContents
   
5.     abc = Range("b2:c4").Value
   
6.     M = Range("b8:c8").Value
   
7.     pc = Range("a14:b17").Value
   
8.     ds = Range("b20").Value
   
9.     ReDim arr%(1 To pc(4, 2))
   
10.     ReDim SJD#(1 To ds, 1 To 3)
    
11.     k = 0
    
12.     For i = 1 To 3
    
13.         For j = 1 To pc(i, 2)
    
14.             k = k + 1
    
15.             arr(k) = pc(i, 1)
    
16.         Next j
    
17.     Next i
    
18.     Randomize
    
19.     For i = 1 To ds
    
20.         r = LBound(arr) + Int(Rnd() * (UBound(arr) - LBound(arr) + 1))
    
21.         SJD(i, 1) = r
    
22.         SJD(i, 2) = (M(1, 1) + abc(arr(r), 1)) / 2 'x坐标
    
23.         SJD(i, 3) = (M(1, 2) + abc(arr(r), 2)) / 2 'y坐标
    
24.         M(1, 1) = SJD(i, 2)
    
25.         M(1, 2) = SJD(i, 3)
    
26.     Next i
    
27.     Range("e2").Resize(ds, 3).Value = SJD
    
28. End Sub

复制代码

附件如下：
谢尔宾斯基三角形.zip (685.76 KB, 下载次数: 21)

2020-1-7 12:41 上传

点击文件名下载附件

原理如下：
1.取三个固定点A、B、C，在平面内充当三角形的三个顶点，彼此不连线；
2.取一随机初始点M，由于我固定的平面直角区域为：x[-10,10]、y[-10,10]，因此，该随机点初值不超过前面限定的20*20的平面范围；
3.按指定频次生成随机数1、2、3，生成总数为ds；
4.若生成1，则将M点向A点靠近距离的一半；若生成2，则将M点向B点靠近距离的一半；若生成3，则将M点向C点靠近距离的一半；
5.以当前点坐标更新M点坐标，不断迭代至ds次数。

aoe1981

下面几个图形是改变A、B、C点出现频次得到的：
1.A点频次显著：




2.B点频次显著：


3.C点频次显著：



4.AB点频次显著：





5.BC点频次显著：




6.AC点频次显著：




只是，Excel图表中点的最小直径为2，显示不够细腻，也就将就着粗糙地玩玩吧……其实，我也主要是为了验证一下，呵呵。

02761752696

老师牛人也

cnmlgb9998

我真搞不懂，用 VBA 去搞这些数字模型问题，有什么意义？ 在实际工作中，有多少问题需要用VBA来解决这么复杂难懂的数字模型？哗众取宠而已。

月关

cnmlgb9998 发表于 2020-1-7 14:00
我真搞不懂，用 VBA 去搞这些数字模型问题，有什么意义？ 在实际工作中，有多少问题需要用VBA来解决这么复 ...

实际工作中，谁的实际工作中呢？不抬扛这是一个子非鱼的问题抬杠就是一个子非我的问题。
很多时候，也有可能只是单纯的一种爱好。同样都是玩，有的人玩世不恭，有的人却玩出了境界。

http://club.excelhome.net/forum. ... digest%26digest%3D1
当成一种美来欣赏也是极好的。

aoe1981

02761752696 发表于 2020-1-7 13:16
老师牛人也

lee1892真大师也，我只是发发神经而已……

aoe1981

cnmlgb9998 发表于 2020-1-7 14:00
我真搞不懂，用 VBA 去搞这些数字模型问题，有什么意义？ 在实际工作中，有多少问题需要用VBA来解决这么复 ...

有“实际工作”的推动，会让学习Excel更有效率和成就……我深感如此。

aoe1981

月关 发表于 2020-1-7 14:19
实际工作中，谁的实际工作中呢？不抬扛这是一个子非鱼的问题抬杠就是一个子非我的问题。
很多时候，也有 ...

我的“玩”，只是为了打发偶尔闲暇的时间……不敢谈境界，脑力退步了，学一点是一点，哈哈。