VBA 使えるソースコード

つたないソースコードを載せます。これは、他人の書いたソースコードを読む練習に最適です。初心者の方は、どうしたらきれいになるかなど考えながら活用してください。

線形代数編

VBA 最小の固有値を求める

Function ramda_min(a() As Double) As Double Dim n As IntegerDim a_inv() As DoubleDim v() As DoubleDim y() As Double n = UBound(a, 1) ReDim y(n)ReDim v(n)ReDim a_inv(n, n) a_inv() = A_inverse(a())v() = vk(a_inv())y() = Ax(a_inv(), v()) ramd…

VBA 固有値を求める(関数)

Function ramda(a() As Double) As Double Dim n As IntegerDim v() As DoubleDim y() As Double n = UBound(a, 1) ReDim y(n)ReDim v(n) v() = vk(a())y() = Ax(a(), v()) ramda = y(1) / v(1) '最初だけ見れば良い End Function 使った関数 ↓ yoronx.haten…

VBA 固有ベクトルを求める(関数)

Function vk(a() As Double) As Double() Dim i As IntegerDim k As IntegerDim l As Integer Dim n As IntegerDim w As DoubleDim sum As Double Dim x() As DoubleDim y() As DoubleDim r() As Double n = UBound(a, 1)l = 10000 ReDim y(n)ReDim x(n) For…

VBA 逆行列を求める(関数)

Function A_inverse(a() As Double) As Double()Dim n As IntegerDim i As IntegerDim k As Integer Dim arr1() As DoubleDim A_inv() As DoubleDim x_n() As Double n = UBound(a, 1) ReDim arr1(n, n)ReDim A_inv(n, n)ReDim x_n(n) For i = 1 To n x_n(i)…

VBA Ax=bを求める(関数)

Function Gauss_kai(a() As Double, b() As Double) As Double() Dim n As IntegerDim m As IntegerDim i As IntegerDim j As Integer Dim arr1() As DoubleDim arr2() As DoubleDim arr3() As DoubleDim arr4() As Double n = UBound(a, 1)m = UBound(b) Re…

VBA 後退代入 Ax=b→Ux=yのxを求める(関数)

Function xxx(U() As Double, y() As Double) As Double()Dim i As IntegerDim j As IntegerDim k As Integer Dim n As IntegerDim m As IntegerDim x As Double Dim arrc() As Double 'xxxになる解そのもの n = UBound(U, 1)m = UBound(y) ReDim arrc(n) ar…

VBA Ax=bの(Ab)を前進消去~ガウス~(関数)

Function Gau_kai(a() As Double, b() As Double) As Double()Dim i As IntegerDim j As IntegerDim k As Integer Dim n As IntegerDim m As IntegerDim x As DoubleDim y As DoubleDim z As DoubleDim w As Double Dim arrA() As DoubleDim arrb() As Doubl…

VBA 行列の積(関数)

Function M_Product(arr1() As Double, arr2() As Double) As Double() Dim i As IntegerDim j As IntegerDim k As IntegerDim n_1 As IntegerDim m_1 As IntegerDim n_2 As IntegerDim m_2 As IntegerDim kadai_14() As Double n_1 = UBound(arr1, 2)m_1 = …

VBA 行列の定数倍(関数)

Function MA(arr1() As Double, a As Double) As Double() Dim m_a() As DoubleDim i As IntegerDim j As IntegerDim n As IntegerDim m As Integer n = UBound(arr1, 2)m = UBound(arr1, 1) ReDim m_a(m, n) For i = 1 To m For j = 1 To n m_a(i, j) = arr…

VBA 行列の差(関数)

Function MM(arr1() As Double, arr2() As Double) As Double() Dim m_m() As DoubleDim i As IntegerDim j As IntegerDim n As IntegerDim m As Integer n = UBound(arr1, 2)m = UBound(arr1, 1) ReDim m_m(m, n) For i = 1 To m For j = 1 To n m_m(i, j) …

VBA 行列の和(関数)

Function MP(arr1() As Double, arr2() As Double) As Double() Dim m_p() As DoubleDim i As IntegerDim j As IntegerDim n As IntegerDim m As Integer n = UBound(arr1, 2)m = UBound(arr1, 1) ReDim m_p(m, n) For i = 1 To m For j = 1 To n m_p(i, j) …

VBA 行列とベクトルの積(関数)

Function Ax(Arr() As Double, arr1() As Double) As Double() Dim i As IntegerDim j As IntegerDim n As IntegerDim m As IntegerDim kadai_10() As Double n = UBound(arr1)m = UBound(Arr, 1) ReDim kadai_10(m) For i = 1 To m For j = 1 To n kadai_10…

VBA ベクトルの定数倍(関数)

Function ab(arr1() As Double, a As Double) As Double() Dim kadai_8() As DoubleReDim kadai_8(UBound(arr1))Dim i As Integer For i = 1 To UBound(arr1) kadai_8(i) = arr1(i) * aNext i ab = kadai_8 End Function

VBA ベクトルの差(関数)

Function a_b(arr1() As Double, arr2() As Double) As Double() Dim kadai_7() As DoubleReDim kadai_7(UBound(arr1))Dim i As Integer For i = 1 To UBound(arr1) kadai_7(i) = arr1(i) - arr2(i)Next i a_b = kadai_7 End Function

VBA ベクトルの和(関数)

Function ab(arr1() As Double, arr2() As Double) As Double() Dim kadai_6() As DoubleReDim kadai_6(UBound(arr1))Dim i As Integer For i = 1 To UBound(arr1) kadai_6(i) = arr1(i) + arr2(i)Next i ab = kadai_6 End Function

VBA 特殊な行列(関数)

Function Tn(ByVal n As Integer) As Double() Dim T_n() As DoubleReDim T_n(n, n)Dim i As IntegerDim j As Integer For i = 1 To n For j = 1 To n If i = j Then T_n(i, j) = 2 ElseIf Abs(i - j) = 1 Then T_n(i, j) = -1 End If Next jNext i Tn = T_n…

VBA 行列の収納(関数)

Function Matrix(ByVal k As Integer, ByVal l As Integer, ByVal m As Integer, ByVal n As Integer) As Double() Dim i As IntegerDim j As IntegerDim Arr() As DoubleReDim Arr(1 To m, 1 To n) For i = 1 To m For j = 1 To n Arr(i, j) = Cells(k - 1 …

VBA ベクトルの収納(関数)

Function Vector(ByVal k As Integer, ByVal l As Integer, ByVal n As Integer) As Double() Dim i As IntegerDim Arr() As DoubleReDim Arr(1 To n)For i = 1 To n Arr(i) = Cells(k - 1 + i, l).ValueNext i Vector = Arr End Function

VBA ベクトルの内積(関数)

Function InnerProd(x() As Integer, y() As Integer) As DoubleDim I As IntegerDim a As Integer For I = 0 To UBound(x()) a = a + x(I) * y(I)Next I InnerProd = a End Function