【VB6.0】VB化神经网络及其矩阵运算源码

随着哈里对VB学习的深入，修改了之前的矩阵运算源码。

源码效率提升了85%，性能提升了12.5%，复杂度提升了N倍 Σ(っ °Д °;)っ

废话不多说，上改版后的VB化Python11行BP网络源码：

Private Sub Command1_Click()
    Dim nv As New numvb
    Dim txt As String, t As Double, te As Double, l0() As Double, l1() As Double
    Dim l2()  As Double, syn0()  As Double, syn1()  As Double, x() As Double, y() As Double
    Dim absM() As Double, nM() As Double, tM() As Double, dM() As Double, rM() As Double
    Dim l2_error() As Double, l1_error() As Double, l2_delta() As Double, l1_delta() As Double
    t = Timer '获得系统当前毫秒时间
    With nv
        .Arr x, 3, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1
        .Arr y, 1, 0, 1, 1, 0
        Randomize (1) '固定随机种子，便于复现
        .Rand rM, 3, 4, 2
        .NumAdd syn0, -1, rM '权值层随机赋值,函数的作用详见后面的模块介绍
        .Rand rM, 4, 1, 2
        .NumAdd syn1, -1, rM
        For i = 1 To 60000 '开始训练
            l0 = x
            .Dot dM, l0, syn0
            .nonlin l1, dM
            .Dot dM, l1, syn1
            .nonlin l2, dM
            .ArrSub l2_error, y, l2
            If i Mod 10000 = 0 Then
                .ArrAbs absM, l2_error
                txt = txt & vbCrLf & "Error:" & .Mean(absM) & vbCrLf '这里输出的是输出层还存在的相对于训练答案的误差
            End If
            .nonlin nM, l2, True
            .ArrDot l2_delta, l2_error, nM
            .ArrT tM, syn1
            .Dot l1_error, l2_delta, tM
            .nonlin nM, l1, True
            .ArrDot l1_delta, l1_error, nM
            .ArrT tM, l1
            .Dot dM, tM, l2_delta
            .ArrAdd_Oneself syn1, dM
            .ArrT tM, l0
            .Dot dM, tM, l1_delta
            .ArrAdd_Oneself syn0, dM
        Next
    End With
    te = Timer
    MsgBox txt & vbCrLf & te - t '输出误差以及用时
End Sub

emmm，害怕了吗？哈哈哈哈……

函数用法如下：

sigmoid函数:nonlin(输出矩阵,矩阵,[是否求导(boolean)])
底数矩阵:NumInd(输出矩阵,底常数,矩阵,[矩阵是否要系数(Double)]) 
矩阵指数:ArrInd(输出矩阵,指常数,矩阵,[矩阵是否要系数(Double)]) 
数加矩阵:NumAdd(输出矩阵,加常数,矩阵,[矩阵是否要系数(Double)]) 
数减矩阵:NumSub(输出矩阵,被减数,矩阵,[矩阵是否要系数(Double)]) 
数乘矩阵:NumDot(输出矩阵,被乘数,矩阵,[矩阵是否要系数(Double)]) 
矩阵加法:ArrAdd(输出矩阵,矩阵A,矩阵B,[结果是否要系数(Double)]) 
矩阵减法:ArrSub(输出矩阵,矩阵A,矩阵B,[结果是否要系数(Double)]) 
哈达玛积:ArrDot(输出矩阵,矩阵A,矩阵B,[结果是否要系数(Double)]) 
数乘矩阵:NumDot(输出矩阵,乘常数,矩阵) 
矩阵乘法:Dot(输出矩阵,矩阵A,矩阵B) 
矩阵可视化:ArrVis(矩阵) 输出字符串
转置矩阵:ArrT(输出矩阵,矩阵,[结果是否要系数(Double)]) 
一维数组矩阵化:ArrA(输出矩阵,列数,一维数组) 
元素矩阵化:Arr(输出矩阵,列数,元素1,元素2,元素3...) 
矩阵绝对值:ArrAbs(输出矩阵,矩阵,[结果是否要系数(Double)]) 
矩阵元素平均:Mean(矩阵) 输出双精度小数
随机小数矩阵:Rand(输出矩阵,行数,列数,[矩阵是否要系数]) 
随机整数矩阵:intRand(输出矩阵,行数,列数,下限,上限) 

接下来是模块的源码~

Public Function Rand(矩阵() As Double, 行 As Long, 列 As Long, Optional 系数 As Double = 1)
Dim i As Long, c As Long
ReDim 矩阵(1 To 行, 1 To 列)
For i = 1 To 行
    For c = 1 To 列
        矩阵(i, c) = Rnd() * 系数
    Next
Next
End Function
Public Function intRand(矩阵() As Double, 行 As Long, 列 As Long, m As Long, n As Long)
Dim i As Long, c As Long
ReDim 矩阵(1 To 行, 1 To 列)
For i = 1 To 行
    For c = 1 To 列
        Randomize
        矩阵(i, c) = Int(Rnd * (n - m + 1)) + m
    Next
Next
End Function
Public Function nonlin(矩阵() As Double, 自() As Double, Optional 导数 As Boolean)
Dim nsM() As Double, niM() As Double, naM() As Double
If 导数 = True Then
    NumSub nsM, 1, 自
    ArrDot 矩阵, 自, nsM
Else
    NumInd niM, Exp(1), 自, -1
    NumAdd naM, 1, niM
    ArrInd 矩阵, -1, naM
End If
End Function
Public Function NumInd(新矩阵() As Double, 底数 As Double, 矩阵() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = 底数 ^ (系数 * 矩阵(i, c))
    Next
Next
End Function
Public Function ArrInd(新矩阵() As Double, 指数 As Double, 矩阵() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = (系数 * 矩阵(i, c)) ^ 指数
    Next
Next
End Function
Public Function NumAdd(新矩阵() As Double, 加数 As Double, 矩阵() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = 系数 * 矩阵(i, c) + 加数
    Next
Next
End Function
Public Function NumSub(新矩阵() As Double, 被减数 As Double, 矩阵() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = 被减数 - 系数 * 矩阵(i, c)
    Next
Next
End Function
Public Function ArrAdd(新矩阵() As Double, 矩阵A() As Double, 矩阵B() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
If UBound(矩阵A, 1) <> UBound(矩阵B, 1) Or UBound(矩阵A, 2) <> UBound(矩阵B, 2) Then MsgBox "维数不一致！", , "arrDot 错误！"
ReDim 新矩阵(1 To UBound(矩阵A, 1), 1 To UBound(矩阵A, 2))
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵A, 2)
        新矩阵(i, c) = 系数 * (矩阵A(i, c) + 矩阵B(i, c))
    Next
Next
End Function
Public Function ArrAdd_Oneself(矩阵A() As Double, 矩阵B() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
If UBound(矩阵A, 1) <> UBound(矩阵B, 1) Or UBound(矩阵A, 2) <> UBound(矩阵B, 2) Then MsgBox "维数不一致！", , "arrDot 错误！"
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵A, 2)
        矩阵A(i, c) = 系数 * (矩阵A(i, c) + 矩阵B(i, c))
    Next
Next
End Function
Public Function ArrSub(新矩阵() As Double, 矩阵A() As Double, 矩阵B() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
If UBound(矩阵A, 1) <> UBound(矩阵B, 1) Or UBound(矩阵A, 2) <> UBound(矩阵B, 2) Then MsgBox "维数不一致！", , "arrDot 错误！"
ReDim 新矩阵(1 To UBound(矩阵A, 1), 1 To UBound(矩阵A, 2))
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵A, 2)
        新矩阵(i, c) = 系数 * (矩阵A(i, c) - 矩阵B(i, c))
    Next
Next
End Function
Public Function ArrDot(新矩阵() As Double, 矩阵A() As Double, 矩阵B() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
If UBound(矩阵A, 1) <> UBound(矩阵B, 1) Or UBound(矩阵A, 2) <> UBound(矩阵B, 2) Then MsgBox "维数不一致！", , "arrDot 错误！"
ReDim 新矩阵(1 To UBound(矩阵A, 1), 1 To UBound(矩阵A, 2))
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵A, 2)
        新矩阵(i, c) = 系数 * 矩阵A(i, c) * 矩阵B(i, c)
    Next
Next
End Function
Public Function NumDot(新矩阵() As Double, 乘数 As Double, 矩阵() As Double)
Dim i  As Long, c As Long
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = 矩阵(i, c) * 乘数
    Next
Next
End Function
Public Function Dot(矩阵C() As Double, 矩阵A() As Double, 矩阵B() As Double)
Dim i As Long, c As Long, v As Long
If UBound(矩阵A, 2) <> UBound(矩阵B, 1) Then MsgBox "维数不一致！", , "错误！": Exit Function
ReDim 矩阵C(1 To UBound(矩阵A, 1), 1 To UBound(矩阵B, 2))
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵B, 2)
        For v = 1 To UBound(矩阵A, 2)
            矩阵C(i, c) = 矩阵A(i, v) * 矩阵B(v, c) + 矩阵C(i, c)
        Next
    Next
Next
End Function
Public Function ArrVis(矩阵() As Double) As String
Dim i As Long, c As Long, 行 As Long, 列 As Long
On Error GoTo Er
行 = UBound(矩阵, 1): 列 = UBound(矩阵, 2)
For i = 1 To 行
    For c = 1 To 列
        If c = 1 Then
            ArrVis = ArrVis & "[" & 矩阵(i, c)
        Else
            ArrVis = ArrVis & "," & 矩阵(i, c)
        End If
    Next
    ArrVis = ArrVis & "]" & vbCrLf
Next
Exit Function
Er:
ArrVis = "矩阵可视化失败！"
End Function
Public Function ArrT(转置矩阵() As Double, 原矩阵() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
ReDim 转置矩阵(1 To UBound(原矩阵, 2), 1 To UBound(原矩阵, 1))
For i = 1 To UBound(原矩阵, 1)
    For c = 1 To UBound(原矩阵, 2)
        转置矩阵(c, i) = 系数 * 原矩阵(i, c)
    Next
Next
End Function
Public Function Mean(矩阵() As Double) As Double
Dim i As Long, c As Long, j As Long
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        j = j + 1
        Mean = Mean + 矩阵(i, c)
    Next
Next
Mean = Mean / j
End Function
Public Function ArrAbs(新矩阵() As Double, 矩阵() As Double, Optional 系数 As Double = 1)
Dim i As Long, c As Long
ReDim 新矩阵(1 To UBound(矩阵, 2), 1 To UBound(矩阵, 1))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(c, i) = 系数 * Abs(矩阵(i, c))
    Next
Next
End Function
Public Function ArrA(矩阵() As Double, 维 As Long, 一维数组)
Dim 行 As Long, 列 As Long, i As Long, c As Long
c = UBound(一维数组) - LBound(一维数组) + 1
If c Mod 维 <> 0 Then MsgBox "元素个数缺失！", , "错误！": Exit Function
ReDim 矩阵(1 To c / 维, 1 To 维)
行 = 1
For i = 1 To c
    列 = 列 + 1
    矩阵(行, 列) = 一维数组(i - 1)
    If 列 Mod 维 = 0 Then 行 = 行 + 1: 列 = 0
Next
End Function
Public Function Arr(矩阵() As Double, 维 As Long, ParamArray 元素集())
Dim 行 As Long, 列 As Long
ReDim 矩阵(1 To (UBound(元素集) + 1) / 维, 1 To 维)
行 = 1
For Each i In 元素集
    列 = 列 + 1
    矩阵(行, 列) = i
    If 列 Mod 维 = 0 Then 行 = 行 + 1: 列 = 0
Next
End Function

 

哈里将模块已打包成了numvbDll.dll（恶搞到底好吧~）。

下载链接：https://download.csdn.net/download/harryxyc/10894430。

————————————————————以下是过去的原文————————————————————————————

学习神经网络的过程中，希望将Python上的神经网络算法移植到VB上，因此自写了一个VB的矩阵运算库，并且恶意的将其命名为"numvb"。

先来看看VB化的网上可搜索到的Python11行代码编写的BP网络：

 

Private Sub Command1_Click()
Dim txt As String: Dim t, te As Double: Dim l0, l1, l2, syn0, syn1
'txt、t、te与神经网络的算法无关
'l0是输入层,l1是隐含层,l2是输出层
'syn0是l0与l1之间的权值层,syn1是l1与l2之间的权值层
t = Timer '获得系统当前毫秒时间
x = Arr(3, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1) '矩阵创建,第一个变量控制列数，后面是矩阵元素的顺序排列
y = Arr(1, 0, 1, 1, 0)
Randomize (1) '固定随机种子，便于复现
syn0 = NumAdd(-1, Rand(3, 4, 2)) '权值层随机赋值,函数的作用详见后面的模块介绍
syn1 = NumAdd(-1, Rand(4, 1, 2))
For i = 1 To 60000 '开始训练
    l0 = x
    l1 = nonlin(Dot(l0, syn0))
    l2 = nonlin(Dot(l1, syn1))
    l2_error = ArrSub(y, l2)
    If i Mod 10000 = 0 Then txt = txt & "Error:" & vbCrLf & Mean(ArrAbs(l2_error)) & vbCrLf '这里输出的是输出层还存在的相对于训练答案的误差
    l2_delta = ArrDot(l2_error, nonlin(l2, True))
    l1_error = Dot(l2_delta, ArrT(syn1))
    l1_delta = ArrDot(l1_error, nonlin(l1, True))
    syn1 = ArrAdd(syn1, Dot(ArrT(l1), l2_delta))
    syn0 = ArrAdd(syn0, Dot(ArrT(l0), l1_delta))
'具体的算法原理可以百度"Python11行 神经网络"
Next
te = Timer
MsgBox txt & vbCrLf & te - t '输出误差以及用时
End Sub

 

这里面涉及的矩阵运算的函数我已经整理到下面的"numvb"模块里。但是运算速度实在捉急，同样运算量，Python只需要1~2秒，而VB需要5~6秒左右。如果哪位大神有更简单更快的算法不妨告诉在下……

接下来是模块函数的使用说明！

 

 

sigmoid函数:nonlin(矩阵,[是否求导(boolean)]) 输出矩阵
底数矩阵:NumInd(底常数,矩阵,[矩阵是否要系数(Double)]) 输出矩阵
矩阵指数:ArrInd(指常数,矩阵,[矩阵是否要系数(Double)]) 输出矩阵
数加矩阵:NumAdd(加常数,矩阵,[矩阵是否要系数(Double)]) 输出矩阵
数减矩阵:NumSub(被减数,矩阵,[矩阵是否要系数(Double)]) 输出矩阵
数乘矩阵:NumDot(被乘数,矩阵,[矩阵是否要系数(Double)]) 输出矩阵
矩阵加法:ArrAdd(矩阵A,矩阵B,[结果是否要系数(Double)]) 输出矩阵
矩阵减法:ArrSub(矩阵A,矩阵B,[结果是否要系数(Double)]) 输出矩阵
哈达玛积:ArrDot(矩阵A,矩阵B,[结果是否要系数(Double)]) 输出矩阵
数乘矩阵:NumDot(乘常数,矩阵) 输出矩阵
矩阵乘法:Dot(矩阵A,矩阵B) 输出矩阵
矩阵可视化:ArrVis(矩阵) 输出字符串
转置矩阵:ArrT(矩阵,[结果是否要系数(Double)]) 输出矩阵
一维数组矩阵化:ArrA(列数,一维数组) 输出矩阵
元素矩阵化:Arr(列数,元素1,元素2,元素3...) 输出矩阵
矩阵绝对值:ArrAbs(矩阵,[结果是否要系数(Double)]) 输出矩阵
矩阵元素平均:Mean(矩阵) 输出双精度小数
随机小数矩阵:Rand(行数,列数,[矩阵是否要系数]) 输出矩阵
随机整数矩阵:intRand(行数,列数,下限,上限) 输出矩阵

 

 

 

接下来就是"numvb"库了 : )  【注意！前方中文代码高能！不习惯的可以自行替换为英文！】

Public Function Rand(ByRef 行 As Long, ByRef 列 As Long, Optional 系数 As Double = 1)
Dim 矩阵(): Dim i, c As Long
ReDim 矩阵(1 To 行, 1 To 列)
For i = 1 To 行
    For c = 1 To 列
        矩阵(i, c) = Rnd() * 系数
    Next
Next
Rand = 矩阵
End Function
Public Function intRand(ByRef 行 As Long, ByRef 列 As Long, ByRef m As Long, ByRef n As Long)
Dim 矩阵(): Dim i, c As Long
ReDim 矩阵(1 To 行, 1 To 列)
For i = 1 To 行
    For c = 1 To 列
        Randomize
        矩阵(i, c) = Int(Rnd * (n - m + 1)) + m
    Next
Next
intRand = 矩阵
End Function
Public Function nonlin(ByRef 自, Optional 导数 As Boolean)
If 导数 = True Then
    nonlin = ArrDot(自, (NumSub(1, 自)))
Else
    nonlin = ArrInd(-1, NumAdd(1, (NumInd(Exp(1), 自, -1))))
End If
End Function
Public Function NumInd(ByRef 底数 As Double, ByRef 矩阵, Optional 系数 As Double = 1)
Dim i, c As Long: Dim 新矩阵()
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = 底数 ^ (系数 * 矩阵(i, c))
    Next
Next
NumInd = 新矩阵()
End Function
Public Function ArrInd(ByRef 指数 As Double, ByRef 矩阵, Optional 系数 As Double = 1)
Dim i, c As Long: Dim 新矩阵()
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = (系数 * 矩阵(i, c)) ^ 指数
    Next
Next
ArrInd = 新矩阵()
End Function
Public Function NumAdd(ByRef 加数 As Double, ByRef 矩阵, Optional 系数 As Double = 1)
Dim i, c As Long: Dim 新矩阵()
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = 系数 * 矩阵(i, c) + 加数
    Next
Next
NumAdd = 新矩阵()
End Function
Public Function NumSub(ByRef 被减数 As Double, ByRef 矩阵, Optional 系数 As Double = 1)
Dim i, c As Long: Dim 新矩阵()
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = 系数 * 被减数 - 矩阵(i, c)
    Next
Next
NumSub = 新矩阵()
End Function
Public Function ArrAdd(ByRef 矩阵A, ByRef 矩阵B, Optional 系数 As Double = 1)
Dim i, c As Long: Dim 新矩阵()
If UBound(矩阵A, 1) <> UBound(矩阵B, 1) Or UBound(矩阵A, 2) <> UBound(矩阵B, 2) Then MsgBox "维数不一致！", , "arrDot 错误！"
ReDim 新矩阵(1 To UBound(矩阵A, 1), 1 To UBound(矩阵A, 2))
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵A, 2)
        新矩阵(i, c) = 系数 * (矩阵A(i, c) + 矩阵B(i, c))
    Next
Next
ArrAdd = 新矩阵()
End Function
Public Function ArrSub(ByRef 矩阵A, ByRef 矩阵B, Optional 系数 As Double = 1)
Dim i, c As Long: Dim 新矩阵()
If UBound(矩阵A, 1) <> UBound(矩阵B, 1) Or UBound(矩阵A, 2) <> UBound(矩阵B, 2) Then MsgBox "维数不一致！", , "arrDot 错误！"
ReDim 新矩阵(1 To UBound(矩阵A, 1), 1 To UBound(矩阵A, 2))
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵A, 2)
        新矩阵(i, c) = 系数 * (矩阵A(i, c) - 矩阵B(i, c))
    Next
Next
ArrSub = 新矩阵()
End Function
Public Function ArrDot(ByRef 矩阵A, ByRef 矩阵B, Optional 系数 As Double = 1)
Dim i, c As Long: Dim 新矩阵()
If UBound(矩阵A, 1) <> UBound(矩阵B, 1) Or UBound(矩阵A, 2) <> UBound(矩阵B, 2) Then MsgBox "维数不一致！", , "arrDot 错误！"
ReDim 新矩阵(1 To UBound(矩阵A, 1), 1 To UBound(矩阵A, 2))
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵A, 2)
        新矩阵(i, c) = 系数 * 矩阵A(i, c) * 矩阵B(i, c)
    Next
Next
ArrDot = 新矩阵()
End Function
Public Function NumDot(ByRef 乘数 As Double, ByRef 矩阵)
Dim i, c As Long: Dim 新矩阵()
ReDim 新矩阵(1 To UBound(矩阵, 1), 1 To UBound(矩阵, 2))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(i, c) = 矩阵(i, c) * 乘数
    Next
Next
NumDot = 新矩阵()
End Function
Public Function Dot(ByRef 矩阵A, ByRef 矩阵B)
Dim 矩阵C(): Dim i, c, v As Long
If UBound(矩阵A, 2) <> UBound(矩阵B, 1) Then MsgBox "维数不一致！", , "错误！": Exit Function
ReDim 矩阵C(1 To UBound(矩阵A, 1), 1 To UBound(矩阵B, 2))
For i = 1 To UBound(矩阵A, 1)
    For c = 1 To UBound(矩阵B, 2)
        For v = 1 To UBound(矩阵A, 2)
            矩阵C(i, c) = 矩阵A(i, v) * 矩阵B(v, c) + 矩阵C(i, c)
        Next
    Next
Next
Dot = 矩阵C()
End Function
Public Function ArrVis(ByRef 矩阵) As String
Dim i, c, 行, 列 As Long
If IsArray(矩阵) Then Else Exit Function
行 = UBound(矩阵, 1): 列 = UBound(矩阵, 2)
For i = 1 To 行
    For c = 1 To 列
        If c = 1 Then
            ArrVis = ArrVis & "[" & 矩阵(i, c)
        Else
            ArrVis = ArrVis & "," & 矩阵(i, c)
        End If
    Next
    ArrVis = ArrVis & "]" & vbCrLf
Next
End Function
Public Function ArrT(ByRef 原矩阵, Optional 系数 As Double = 1)
Dim 转置矩阵(): Dim i, c As Long
ReDim 转置矩阵(1 To UBound(原矩阵, 2), 1 To UBound(原矩阵, 1))
For i = 1 To UBound(原矩阵, 1)
    For c = 1 To UBound(原矩阵, 2)
        转置矩阵(c, i) = 系数 * 原矩阵(i, c)
    Next
Next
ArrT = 转置矩阵()
End Function
Public Function Mean(ByRef 矩阵) As Double
Dim i, c, j As Long
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        j = j + 1
        Mean = Mean + 矩阵(i, c)
    Next
Next
Mean = Mean / j
End Function
Public Function ArrAbs(ByRef 矩阵, Optional 系数 As Double = 1)
Dim 新矩阵(): Dim i, c As Long
ReDim 新矩阵(1 To UBound(矩阵, 2), 1 To UBound(矩阵, 1))
For i = 1 To UBound(矩阵, 1)
    For c = 1 To UBound(矩阵, 2)
        新矩阵(c, i) = 系数 * Abs(矩阵(i, c))
    Next
Next
ArrAbs = 新矩阵()
End Function
Public Function ArrA(ByRef 维 As Long, ByRef 一维数组)
Dim 行, 列 As Long: Dim 矩阵(): Dim i, c
c = UBound(一维数组) - LBound(一维数组) + 1
If c Mod 维 <> 0 Then MsgBox "元素个数缺失！", , "错误！": Exit Function
ReDim 矩阵(1 To c / 维, 1 To 维)
行 = 1
For i = 1 To c
    列 = 列 + 1
    矩阵(行, 列) = 一维数组(i - 1)
    If 列 Mod 维 = 0 Then 行 = 行 + 1: 列 = 0
Next
ArrA = 矩阵()
End Function
Public Function Arr(ByRef 维 As Long, ParamArray 元素集())
Dim 行, 列 As Long: Dim 矩阵(): Dim i
ReDim 矩阵(1 To (UBound(元素集) + 1) / 维, 1 To 维)
行 = 1
For Each i In 元素集
    列 = 列 + 1
    矩阵(行, 列) = i
    If 列 Mod 维 = 0 Then 行 = 行 + 1: 列 = 0
Next
Arr = 矩阵()
End Function

 

以上就是全部了，如有疑问欢迎告知 : )