VBA 数値計算用最新マクロ（常時更新されます）

　当サイトの VBA 数値計算用マクロのなかには複数の Function Macro を参照するものがあります。以下のコードは当サイトのマクロを確実に動作させるための基幹ライブラリです。このページは新たにライブラリが追加されるごとに更新されます。最新記事のマクロを使用するにあたっては、コードをコピーし直してモジュールに上書きするようにしてください。なお、この基幹ライブラリが必要なマクロを掲載する場合は、その都度注意書きが掲載されます。そのような注意書きが載っていない記事にあるマクロは単独で使用できます。

Option Base 1

Dim pi As Double
Dim i As Integer, j As Integer

'複素数型変数の定義

Type Complex
re As Double
im As Double
End Type

'ガウスの超幾何関数　(C)BlogCat

Function GHGEO(a As Double, b As Double, c As Double, _
x As Double) As Double

Dim fact As Long
Dim s As Double

d = a * b / c

s = 1 + d * x

For k = 2 To 100

d = d * (a + k - 1) * (b + k - 1) / (c + k - 1) / k

s = s + d * x ^ k

Next k

GHGEO = s

End Function

'合流超幾何級数　(C)BlogCat
Function CHGEO(a As Double, c As Double, x As Double) As Double

Dim d As Double
Dim s As Double

d = a * x / c

s = 1 + d

For k = 1 To 200

d = d * x * (a + k) / (c + k) / (k + 1)

s = s + d

Next k

CHGEO = s

End Function

'複素変数の合流超幾何関数　(C)BlogCat

Function CXCHGEO(a As Double, c As Double, z As Complex) As Complex

Dim d As Double
Dim k As Double
Dim s As Complex
Dim zk As Complex

d = a / c

s.re = 1 + d * z.re
s.im = d * z.im
zk = z

For k = 2 To 100

d = d * (a + k - 1) / (c + k - 1) / k

zk = CPXCLC(zk, z, 3)

s.re = s.re + d * zk.re
s.im = s.im + d * zk.im

Next k

CXCHGEO = s

End Function

'ラゲール陪多項式　(C)BlogCat
Function LAG(n As Integer, k As Integer, x As Double)

nfact = WorksheetFunction.fact(n)
kfact = WorksheetFunction.fact(k)
nkfact = WorksheetFunction.fact(n - k)

LAG = (-1) ^ k * nfact ^ 2 * CHGEO(k - n, k + 1, x) / kfact / nkfact

End Function

'第1種不完全ガンマ関数　(C)BlogCat
Function INCGMA(a As Double, z As Complex) As Complex

Dim za As Complex
Dim mz As Complex
Dim zada As Complex
Dim fz As Complex

'z^a
za = CXPOWER(z, CPX(a, 0))

'z^a/a
zada = CPXCLC(za, CPX(a, 0), 4)

'-z
mz = CPXCLC(CPX(-1, 0), z, 3)

'F(a,a+1,-z)
fz = CXCHGEO(a, a + 1, mz)

INCGMA = CPXCLC(zada, fz, 3)

End Function

'第2種不完全ガンマ関数　(C)BlogCat
Function INCGMA2(a As Double, z As Complex) As Complex

Dim k As Integer
Dim gmaa As Double
Dim zk As Complex
Dim ck As Complex, dk As Complex
Dim s As Complex, logz As Complex
Dim cpxgmaa As Complex

If a = 0 Then

logz = CXLOG(z)

s.re = -gm - logz.re + z.re
s.im = -logz.im + z.im

ck.re = -z.re
ck.im = -z.im

For k = 2 To 100

dk = CPXCLC(CPX((1 - k) / k ^ 2, 0), z, 3)
ck = CPXCLC(dk, ck, 3)

s.re = s.re - ck.re
s.im = s.im - ck.im

Next k

INCGMA2 = s

Else

gmaa = WorksheetFunction.Gamma(a)
cpxgmaa = CPX(gmaa, 0)

INCGMA2 = CPXCLC(cpxgmaa, INCGMA(a, z), 2)

End If

End Function

'指数積分関数 Ei(x)
Function EI(x As Double) As Double

Dim d As Double, k As Double, s As Double
Dim z1 As Complex, mz As Complex
Dim gmz As Complex, mgmz As Complex

'x が小さいところでは不完全ガンマ関数を用います
If x <= 50 Then

z1.re = x
z1.im = 0

'-z
mz = CPXCLC(CPX(-1, 0), z1, 3)

'Γ(0,-z)
gmz = INCGMA2(0, mz)

'-Γ(0,-z)
mgmz = CPXCLC(CPX(-1, 0), gmz, 3)

EI = mgmz.re

'x が大きいところでは漸近展開を用います
Else

d = 1
s = 1

For k = 1 To 10

d = d * k / x

s = s + d

Next k

EI = s * exp(x) / x

End If

End Function

'余弦積分
Function CI(x As Double) As Double

Dim p As Double, q As Double, r As Double
Dim h As Double, s As Double, gm As Double
Dim m As Integer, k As Integer

gm = 0.5772156649

m = 100
h = x / (2 * m)

s = (Cos(h) - 1) / h + (Cos(2 * h) - 1) / (2 * h)

For k = 1 To m - 1
p = 2 * k * h

q = (2 * k + 1) * h

r = (2 * k + 2) * h

s = s + (Cos(p) - 1) / p + 4 * (Cos(q) - 1) / q + (Cos(r) - 1) / r

Next k

CI = gm + Log(x) + s * h / 3

End Function

'正弦積分
Function SI(x As Double) As Double

Dim p As Double, q As Double, r As Double
Dim h As Double, s As Double
Dim m As Integer, k As Integer

m = 100
h = x / (2 * m)

s = 1 + Sin(h) / h + Sin(2 * h) / (2 * h)

For k = 1 To m - 1

p = 2 * k * h

q = (2 * k + 1) * h

r = (2 * k + 2) * h

s = s + Sin(p) / p + 4 * Sin(q) / q + Sin(r) / r

Next k

SI = s * h / 3

End Function

'エルミート多項式　(C)BlogCat
Function HMT(n As Integer, x As Double, _
Optional unx As Boolean = False) As Double

Dim sqpi As Double
Dim k As Double

sqpi = Sqr(4 * Atn(1))
nfact = WorksheetFunction.fact(n)

k = 1 / Sqr((sqpi * 2 ^ n * nfact))

If n = 0 Then

HMT = 1

ElseIf n = 1 Then

HMT = 2 * x

ElseIf n Mod 2 = 0 Then

p = n / 2

pfact = WorksheetFunction.fact(p)
pfact2 = WorksheetFunction.fact(2 * p)

HMT = (-1) ^ p * pfact2 * CHGEO(-p, 0.5, x ^ 2) / pfact

Else

p = n \ 2

pfact = WorksheetFunction.fact(p)
pfact2 = WorksheetFunction.fact(2 * p + 1)

HMT = (-1) ^ p * pfact2 * x * CHGEO(-p, 1.5, x ^ 2) / pfact

End If

If unx = True Then

HMT = k * HMT * exp(-x ^ 2 / 2)

End If

End Function

'複素数の定義
Function CPX(a As Double, b As Double) As Complex

CPX.re = a
CPX.im = b

End Function

'極形式の複素数
Function CPX2(x As Double, Optional a As Double = 1) As Complex

CPX2.re = a * Cos(x)
CPX2.im = a * Sin(x)

End Function

'共役複素数
Function CJG(z As Complex) As Complex

CJG.re = z.re
CJG.im = -z.im

End Function

'複素数の絶対値
Function CPXABS(z As Complex, _
Optional s As Boolean = True) As Double

CPXABS = z.re ^ 2 + z.im ^ 2

If s = True Then

CPXABS = Sqr(CPXABS)

End If

End Function

'複素数の演算　(C)BlogCat
Function CPXCLC(z1 As Complex, z2 As Complex, _
Optional s As Integer = 1) As Complex

Dim k As Double
Dim z As Complex

Select Case s

Case 1
z.re = z1.re + z2.re
z.im = z1.im + z2.im

Case 2
z.re = z1.re - z2.re
z.im = z1.im - z2.im

Case 3
z.re = z1.re * z2.re - z1.im * z2.im
z.im = z1.re * z2.im + z1.im * z2.re

Case Else

k = z2.re ^ 2 + z2.im ^ 2

z.re = (z1.re * z2.re + z1.im * z2.im) / k
z.im = (z1.im * z2.re - z1.re * z2.im) / k

End Select

CPXCLC = z

End Function

'複素平面上の 2 点間の距離
Function CPXD(z1 As Complex, z2 As Complex, _
Optional s As Boolean = True) As Double

CPXD = (z1.re - z2.re) ^ 2 + (z1.im - z2.im) ^ 2

If s = True Then

CPXD = Sqr(CPXD)

End If

End Function

'複素変数の指数関数
Function CEXP(z As Complex) As Complex

CEXP.re = exp(z.re) * (Cos(z.im))
CEXP.im = exp(z.re) * (Sin(z.im))

End Function

'偏角を計算　(C)BlogCat
Function CPXARG(z As Complex, _
Optional s1 As Boolean = False, _
Optional s2 As Boolean = False) As Double

pi = 4 * Atn(1)

Select Case s1

'範囲を 0 ～2πにする場合（初期設定 ON）
Case False

If z.re = 0 And z.im > 0 Then

CPXARG = pi / 2

ElseIf z.re = 0 And z.im < 0 Then

CPXARG = 3 * pi / 2

ElseIf z.re < 0 And z.im = 0 Then

CPXARG = pi

ElseIf z.re > 0 And z.im >= 0 Then

CPXARG = Atn(z.im / z.re)

ElseIf z.re < 0 And z.im <> 0 Then

CPXARG = Atn(z.im / z.re) + pi

ElseIf z.re > 0 And z.im < 0 Then

CPXARG = Atn(z.im / z.re) + 2 * pi

End If

'範囲を -π ～πにする場合（初期設定 ON）
Case Else

If z.re = 0 And z.im > 0 Then

CPXARG = pi / 2

ElseIf z.re = 0 And z.im < 0 Then

CPXARG = -3 * pi / 2

ElseIf z.re < 0 And z.im = 0 Then

CPXARG = -pi

ElseIf z.re > 0 Then

CPXARG = Atn(z.im / z.re)

ElseIf z.re < 0 And z.im > 0 Then

CPXARG = Atn(z.im / z.re) + pi

ElseIf z.re < 0 And z.im < 0 Then

CPXARG = Atn(z.im / z.re) - pi

End If

End Select

'角度の単位を度数単位にする場合（初期設定 OFF）
If s2 = True Then

CPXARG = 180 * CPXARG / pi

End If

End Function

'複素変数の対数関数　(C)BlogCat
Function CXLOG(z As Complex, _
Optional s As Boolean = False) As Complex

Dim absz As Double
Dim argz As Double
Dim logz As Complex
Dim iargz As Complex

absz = CPXABS(z)
argz = CPXARG(z)

If s = True Then

argz = CPXARG(z, True)

End If

logz = CPX(Log(absz), 0)
iargz = CPXCLC(CPX(0, 1), CPX(argz, 0), 3)

CXLOG = CPXCLC(logz, iargz)

End Function

'複素数のベキ乗　(C)BlogCat
Function CXPOWER(z As Complex, a As Complex, _
Optional s As Boolean = False) As Complex

Dim alogz As Complex

If z.re = 0 And z.im = 0 Then

CXPOWER = CPX(0, 0)

Else

alogz = CPXCLC(a, CXLOG(z), 3)

If s = True Then

alogz = CPXCLC(a, CXLOG(z, True), 3)

End If

CXPOWER = CEXP(alogz)

End If

End Function

'cosz　(C)BlogCat
Function CXCOS(z As Complex) As Complex

Dim iz1 As Complex
Dim iz2 As Complex
Dim cz As Complex

iz1 = CPXCLC(CPX(0, 1), z, 3)
iz2 = CPXCLC(CPX(0, -1), z, 3)

cz = CPXCLC(CEXP(iz1), CEXP(iz2))

CXCOS = CPXCLC(cz, CPX(2, 0), 4)

End Function

'sinz　(C)BlogCat
Function CXSIN(z As Complex) As Complex

Dim iz1 As Complex
Dim iz2 As Complex
Dim cz As Complex

iz1 = CPXCLC(CPX(0, 1), z, 3)
iz2 = CPXCLC(CPX(0, -1), z, 3)

cz = CPXCLC(CEXP(iz1), CEXP(iz2), 2)

CXSIN = CPXCLC(cz, CPX(0, 2), 4)

End Function

'tanz　(C)BlogCat
Function CXTAN(z As Complex) As Complex

CXTAN = CPXCLC(CXSIN(z), CXCOS(z), 4)

End Function

Sub testa()

Dim x As Complex

x = CXCHGEO(1, 2, CPX(-1, 0))

Debug.Print x.re
End Sub

　当サイトのマクロの著作権は全て Blog Cat に帰属します。
　利用は個人的な目的に限って許可されます。
　商用・非商用に関わらず、２次配布は禁止します。