|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 aoe1981 于 2020-1-11 20:43 编辑
图如下:
迭代0次:
迭代1次:
迭代2次:
迭代3次:
迭代4次:
迭代5次:
迭代6次:
……
操作界面如下:
原理容后备注。
代码如下(全部公开):
- Option Explicit
- Public Sub FX_xh()
- Dim DD0#(), DDi#(), m&, n&, ni&, i&, j&, jd#, jdd1#, jdd2#
- If Range("d19").Value <> "正确" Then MsgBox "参数不正确。": Range("d19").Select: End
- n = 3
- ReDim DD0#(1 To 4, 1 To 3)
- For i = 1 To 3
- DD0(i, 1) = i
- DD0(i, 2) = Cells(i + 1, 2).Value
- DD0(i, 3) = Cells(i + 1, 3).Value
- Next i
- DD0(4, 1) = 4
- DD0(4, 2) = Cells(2, 2).Value
- DD0(4, 3) = Cells(2, 3).Value
- jdd1 = Range("d17").Value
- jdd2 = Range("d18").Value
- jd = Range("c7").Value
- Range("f2").Resize(1000000, 3).ClearContents
- Range("d13:d14").Value = n
- Range("f2").Resize(n + 1, 3).Value = DD0
- If Range("d26").Value = "是" Then GFTB
- Delay (Range("b14").Value)
- m = Range("b13").Value
- For i = 1 To m
- ni = n + n * 3
- ReDim DDi#(1 To ni + 1, 1 To 3)
- For j = 1 To n
- DDi(4 * (j - 1) + 1, 1) = 4 * (j - 1) + 1 '端点1
- DDi(4 * (j - 1) + 1, 2) = DD0(j, 2)
- DDi(4 * (j - 1) + 1, 3) = DD0(j, 3)
-
- DDi(4 * (j - 1) + 2, 1) = 4 * (j - 1) + 2 '截断点1
- DDi(4 * (j - 1) + 2, 2) = DD0(j, 2) * (1 - jdd1) + DD0(j + 1, 2) * jdd1
- DDi(4 * (j - 1) + 2, 3) = DD0(j, 3) * (1 - jdd1) + DD0(j + 1, 3) * jdd1
-
- DDi(4 * (j - 1) + 4, 1) = 4 * (j - 1) + 4 '截断点2
- DDi(4 * (j - 1) + 4, 2) = DD0(j, 2) * (1 - jdd2) + DD0(j + 1, 2) * jdd2
- DDi(4 * (j - 1) + 4, 3) = DD0(j, 3) * (1 - jdd2) + DD0(j + 1, 3) * jdd2
-
- DDi(4 * (j - 1) + 3, 1) = 4 * (j - 1) + 3 '生成点1
- DDi(4 * (j - 1) + 3, 2) = Cos(jd) * (DDi(4 * (j - 1) + 4, 2) - DDi(4 * (j - 1) + 2, 2)) + Sin(jd) * (DDi(4 * (j - 1) + 4, 3) - DDi(4 * (j - 1) + 2, 3)) + DDi(4 * (j - 1) + 2, 2)
- DDi(4 * (j - 1) + 3, 3) = -Sin(jd) * (DDi(4 * (j - 1) + 4, 2) - DDi(4 * (j - 1) + 2, 2)) + Cos(jd) * (DDi(4 * (j - 1) + 4, 3) - DDi(4 * (j - 1) + 2, 3)) + DDi(4 * (j - 1) + 2, 3)
- Next j
- DDi(ni + 1, 1) = ni + 1
- DDi(ni + 1, 2) = DD0(1, 2)
- DDi(ni + 1, 3) = DD0(1, 3)
- Range("d13:d14").Value = ni
- Range("f2").Resize(ni + 1, 3).Value = DDi
- DD0 = DDi
- n = ni
- If Range("d26").Value = "是" Then GFTB
- Delay (Range("b14").Value)
- Next i
- End Sub
- Public Sub GFTB()
- Application.ScreenUpdating = False
- Sht.Unprotect
- Sht.ChartObjects("图表 3").Activate
- With ActiveChart
- .Axes(xlValue).MinimumScale = Range("c23").Value
- .Axes(xlValue).MaximumScale = Range("d23").Value
- .Axes(xlValue).MajorUnit = Range("b26").Value
- .Axes(xlCategory).MinimumScale = Range("a23").Value
- .Axes(xlCategory).MaximumScale = Range("b23").Value
- .Axes(xlCategory).MajorUnit = Range("b26").Value
- End With
- Range("e1").Select
- Sht.Protect
- Application.ScreenUpdating = True
- End Sub
- Public Sub Delay(T As Single) '延时
- Dim time1!, time2!
- time1 = Timer()
- Do
- DoEvents
- time2 = Timer() - time1
- If time2 < 0 Then time2 = time2 + 86400
- Loop While time2 < T
- End Sub
复制代码
附件如下:
科赫雪花.zip
(488.53 KB, 下载次数: 37)
本附件制作与前面三个相关帖的方法不一样,对于我而言:原创较多(当然,这些不是新东西,大神们早都司空见惯了,我却是独立首次),值得备注。
|
评分
-
3
查看全部评分
-
|