Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
Mandel Brot
投稿日時: 23/07/12 14:16:35
投稿者: TomVla

以下のプログラムでExcelシートに数字のマトリックスが描画されるはずですが動作しません。
対応方法アドバイスお願いします。
 
Function CalDivCount(x0 As Double, y0 As Double, a As Double, b As Double, _
                    Optional MaxCnt As Long = 100) As Long
 
    Dim Cnt as Long
    Dim x As Double, y As Double, xn As Double, yn As Double
    Dim s As Double, S0 As Double
 
    xn = x0: yn= y0
    Cnt = 0
 
    Do
 
        x = xn * xn - yn * yn + a
        y = 2 * xn * yn + b
 
        S = x * x + y * y
 
        xn = x: yn = y
        Cnt = Cnt + 1
 
        If S = S0 Then Cnt = MaxCnt
 
        S0 = S
 
    Loop While ((S < 4#) And (Cnt < MaxCnt))
 
    CalDivCount = Cnt
 
End Function
 
出典は https://mt-soft.sakura.ne.jp/kyozai/excel_vba/320_vba_high/10_mandelbrot/main.html です。

回答
投稿日時: 23/07/12 16:10:08
投稿者: QooApp

普通に動きますがどのような症状でしょうか。
 
スクリプトの挿入シートが標準モジュールではない場所にスクリプトを設置していませんか?
 
挿入>標準モジュール で生成されるシートにスクリプトを張り付けて、
任意のセルから
 
=CalDivCount(0,0,J$1,$A9)
 
というように呼び出せば動作すると思います。
動作しない場合は投稿フォームの選択欄にあるWindowsのバージョンやソフトウェアのバージョンを指定していただけると対応しやすいと思います。
 
こちらはWin10 Pro / Office365 + 2019のエクセルそれぞれで動作を確認しています。

回答
投稿日時: 23/07/12 16:16:45
投稿者: QooApp

	A	B	C	D	E	F	G	H	I
1		-2	-1.9	-1.8	-1.7	-1.6	-1.5	-1.4	-1.3
2	-2	1	1	1	1	1	1	1	1
3	-1.9	1	1	1	1	1	1	1	1
4	-1.8	1	1	1	1	1	1	1	1
5	-1.7	1	1	1	1	1	1	1	1
6	-1.6	1	1	1	1	1	1	1	1
7	-1.5	1	1	1	1	1	1	1	2
8	-1.4	1	1	1	1	1	1	2	2
9	-1.3	1	1	1	1	1	2	2	2

 
B2のセルに
 
=CalDivCount(0,0,B$1,$A2)
 
と書いてあとは複製すればよいでしょう

回答
投稿日時: 23/07/12 16:32:11
投稿者: 半平太

門外漢の私にはよく分からないですが、こんな話なのかなぁ。
 

Sub test()
    Const size = 81 '表示枠数(奇数)
    
    Dim delta As Double
    Dim Start
    Dim i, k
    Dim rslt(1 To size, 1 To size)
    
    Start = 2
    delta = Start * 2 / (size - 1)
    
    For i = 1 To size
        For k = 1 To size
            rslt(i, k) = CalDivCount(0, 0, Abs(Start - (i - 1) * delta), Abs(Start - (k - 1) * delta))
        Next k
    Next i
    
    Range("B2").Resize(UBound(rslt), UBound(rslt, 2)) = rslt
End Sub

投稿日時: 23/07/12 16:45:01
投稿者: TomVla

QooAppさん  半平太さん
ご回答ありがとうございます。ご指摘内容検討します。
すぐに手が付けられない状態でして、後日結果を報告いたします。
とりあえずお礼申し上げます。

投稿日時: 23/07/24 07:37:17
投稿者: TomVla

QooAppさん 半平太さん
遅くなりましたがやっと戻ってきました。
やはりVBAの基本的なことの習得が十分でないようです。
お教えいただいた内容を吟味して勉強を進めます。
解決しそうで、していませんが一旦クローズさせていただきます。
そのうえで再度挑戦いたします。
ありがとうございました。
TomVla