「Fractal」
https://www.moug.net/faq/viewtopic.php?t=82394
について、検討してみました。
【用意するもの】
・Sheet1 描画用のシート（特段の準備は不要）
・Sheet2 カラー用の情報を持たせるもの。
最下段にあるデータをコピーペイストしてください。
【手順】
1. 下記のコードを標準モジュールにコピーペイストして下さい。
2. main プロシージャを実行してください。
7,8秒で描画が完成するはずです。
【参考コード】
Dim ws As Worksheet
Dim wsColor As Worksheet
Sub main()
Dim n& ' & は As Longと同じ
Dim baseX&, baseY&, m&
Dim mx#, my#, w# ' # は As Doubleと同じ
Dim u#, v#
Dim rng As Range
Dim i&, j&, l&
Set ws = Worksheets("Sheet1") '描画用シート
Set wsColor = Worksheets("Sheet2") 'カラー情報
Application.ScreenUpdating = False
n = 200 '収束判定の繰返し上限
baseX = 200 '書き込みセルの基準位置(描画範囲の中点）
baseY = 200
m = 199 'mesh（上下、左右とも約400に分割）
'複素平面上の点の範囲設定
mx = -0.6 'X軸方向の中点
my = 0# 'Y軸方向の中点
w = 1.4 '片側の幅
'(x軸方向[-2.0,0.8]、y軸方向[-1.4,1.4]の範囲)
'青系統のカラーマップを利用
Dim colormap As Variant
colormap = getColorMap()
With ws
Set rng = .Cells(1, 1).Resize(2 * m + 1, 2 * m + 1) '描画範囲
.Activate
ActiveWindow.Zoom = 100
rng.EntireRow.RowHeight = 3.75
rng.EntireColumn.ColumnWidth = 0.38
rng.ClearFormats
For i = -m To m
u = mx + w * i / m
For j = -m To m
v = my + w * j / m
l = mandelbrot(u, v, n) '初めて半径２の円の外に出るまでの繰返し回数
'セルに着色
If l >= n Then '最後まで外に出ない（収束）ケース
.Cells(baseY + j, baseX + i).Interior.Color = RGB(0, 0, 0) '黒
Else
.Cells(baseY + j, baseX + i).Interior.Color = colormap(n - l) '青系
End If
Next
Next
.Activate
ActiveWindow.Zoom = 50
End With
Application.ScreenUpdating = True
MsgBox "終了"
End Sub
Function mandelbrot(u#, v#, n&) As Long
'f = z^2 + c（複素平面上）で、z=0からスタートし z[n+1] = f(z[n]) で順次z[n]を計算
'収束判定を実行（既定の円領域をはずれたときに発散と判断）
'そのときまでの繰り返し回数を返す
Dim l&, x#, y#, zx#, zy#
x = 0: y = 0
For l = 1 To n
zx = x ^ 2 - y ^ 2 + u
zy = 2 * x * y + v
x = zx: y = zy
If x ^ 2 + y ^ 2 > 4 Then Exit For 'みなし発散判定
Next
mandelbrot = l
End Function
Function getColorMap() As Variant
Dim j&, k&
Dim mat(1 To 200)
For j = 1 To 8
For k = 1 To 25
mat(k + (j - 1) * 25) = wsColor.Cells(k, j)
Next
Next
getColorMap = mat
End Function
== ここまで ====
■Sheet2の A1:H25に下記の数値をコピーペイストして下さい
16710898 16710897 16644845 16578791 16446684 16248008 15850143 14789457
16710898 16710897 16644845 16578791 16446684 16248006 15849885 14657614
16710898 16710896 16644845 16578791 16446683 16182213 15784090 14591306
16710898 16710896 16644845 16578790 16446683 16182212 15783832 14459206
16710898 16710640 16644845 16578790 16446426 16181955 15783318 14327362
16710898 16710640 16644844 16578790 16446425 16181954 15717523 14195262
16710898 16710640 16644844 16578789 16380889 16181696 15717264 14063163
16710898 16710640 16644844 16578533 16380888 16181695 15716750 13865527
16710898 16710640 16644844 16512997 16380631 16115902 15650955 13667892
16710898 16710640 16644844 16512996 16380630 16115644 15650440 13470001
16710898 16645104 16644843 16512996 16380630 16115643 15584645 13272366
16710898 16645103 16644843 16512995 16380373 16115385 15584130 13008939
16710898 16645103 16644843 16512995 16380372 16115128 15518335 12679977
16710898 16645103 16644843 16512995 16380371 16049590 15517820 12351015
16710898 16645103 16644586 16512738 16314834 16049332 15451769 12021797
16710897 16645103 16579050 16512738 16314578 16049075 15385718 11627299
16710897 16645103 16579050 16512737 16314577 16048817 15385202 11232545
16710897 16645103 16579050 16512737 16314320 15983279 15319151 10772255
16710897 16645102 16579049 16512736 16314319 15983021 15253099 10311965
16710897 16645102 16579049 16512736 16314318 15982763 15186792 9785883
16710897 16645102 16579049 16512479 16314061 15982505 15120740 9194521
16710897 16645102 16579049 16446943 16248524 15916712 15054433 8602903
16710897 16645102 16579048 16446942 16248523 15916453 14988381 7945748
16710897 16645102 16579048 16446942 16248266 15916195 14922073 7288593
16710897 16645102 16578792 16446941 16248265 15850401 14855765 6500110
