Excel实战：从零构建BP神经网络模型（附完整代码）

1次阅读

共计 3810 个字符，预计需要花费 10 分钟才能阅读完成。

刚入门数据科学时，我发现传统统计工具（比如 Excel 自带的回归分析）遇到复杂模式就束手无策。比如要预测用户购买行为这种非线性问题，用简单的线性回归准确率连 50% 都达不到。更难受的是，当我兴冲冲打开 Python 的 TensorFlow 教程，又被环境配置和代码复杂度劝退——难道就没有折中方案吗？

和 Python 生态相比，Excel+VBA 的组合有这些特点：

零环境依赖：所有 Windows 电脑自带 Excel，不用折腾 pip install
可视化调试：每个中间计算结果都能实时查看单元格数值
教学友好性：通过单步执行可以观察权重如何逐层更新

当然也有局限：处理海量数据会卡顿，但用来学习神经网络原理完全够用。下面我们就用鸢尾花分类任务来实战。

在 Sheet1 按如下格式准备数据（示例取前 5 行）：

花萼长度	花萼宽度	花瓣长度	花瓣宽度	类别
5.1	3.5	1.4	0.2	0
4.9	3.0	1.4	0.2	0

注：类别需转为数字（Setosa=0, Versicolor=1, Virginica=2）

按 Alt+F11 打开 VBA 编辑器，插入新模块，先声明核心变量：

' 网络结构参数
Public input_size As Integer  ' 输入特征数（示例中为 4）Public hidden_size As Integer ' 隐藏层神经元数（建议 4 -8）Public output_size As Integer '输出类别数（示例为 3）' 权重矩阵
Public W1() As Double  ' 输入层 -> 隐藏层权重
Public W2() As Double  ' 隐藏层 -> 输出层权重

在模块中添加初始化函数（使用随机小数值）：

Sub InitializeNetwork()
    Randomize
    input_size = 4
    hidden_size = 6
    output_size = 3

    ReDim W1(1 To hidden_size, 1 To input_size)
    ReDim W2(1 To output_size, 1 To hidden_size)

    ' 用 [-0.5,0.5] 区间随机数初始化
    For i = 1 To hidden_size
        For j = 1 To input_size
            W1(i, j) = Rnd() - 0.5
        Next j
    Next i

    For i = 1 To output_size
        For j = 1 To hidden_size
            W2(i, j) = Rnd() - 0.5
        Next j
    Next i
End Sub

Function Sigmoid(x As Double) As Double
    Sigmoid = 1 / (1 + Exp(-x))
End Function

' 导数计算（用于反向传播）Function SigmoidDerivative(x As Double) As Double
    Dim s As Double
    s = Sigmoid(x)
    SigmoidDerivative = s * (1 - s)
End Function

Function ForwardPass(inputs() As Double) As Double()
    Dim hidden() As Double, outputs() As Double
    ReDim hidden(1 To hidden_size)
    ReDim outputs(1 To output_size)

    ' 隐藏层计算
    For i = 1 To hidden_size
        hidden(i) = 0
        For j = 1 To input_size
            hidden(i) = hidden(i) + W1(i, j) * inputs(j)
        Next j
        hidden(i) = Sigmoid(hidden(i))
    Next i

    ' 输出层计算
    For i = 1 To output_size
        outputs(i) = 0
        For j = 1 To hidden_size
            outputs(i) = outputs(i) + W2(i, j) * hidden(j)
        Next j
        outputs(i) = Sigmoid(outputs(i))
    Next i

    ForwardPass = outputs
End Function

Sub BackPropagate(inputs() As Double, targets() As Double, learning_rate As Double)
    ' 前向传播获取各层输出
    Dim hidden() As Double, outputs() As Double
    hidden = CalculateHiddenLayer(inputs)
    outputs = ForwardPass(inputs)

    ' 输出层误差
    Dim output_errors() As Double
    ReDim output_errors(1 To output_size)
    For i = 1 To output_size
        output_errors(i) = (targets(i) - outputs(i)) * SigmoidDerivative(outputs(i))
    Next i

    ' 隐藏层误差
    Dim hidden_errors() As Double
    ReDim hidden_errors(1 To hidden_size)
    For j = 1 To hidden_size
        hidden_errors(j) = 0
        For i = 1 To output_size
            hidden_errors(j) = hidden_errors(j) + output_errors(i) * W2(i, j)
        Next i
        hidden_errors(j) = hidden_errors(j) * SigmoidDerivative(hidden(j))
    Next j

    ' 更新权重 W2
    For i = 1 To output_size
        For j = 1 To hidden_size
            W2(i, j) = W2(i, j) + learning_rate * output_errors(i) * hidden(j)
        Next j
    Next i

    ' 更新权重 W1
    For i = 1 To hidden_size
        For j = 1 To input_size
            W1(i, j) = W1(i, j) + learning_rate * hidden_errors(i) * inputs(j)
        Next j
    Next i
End Sub

把双重循环改为矩阵运算可提速 3 倍以上：

' 在模块顶部声明矩阵操作函数
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, Source As Any, ByVal Length As LongPtr)

Function MatrixMultiply(A() As Double, B() As Double) As Double()
    '... 省略具体实现...
End Function

早停法（Early Stopping）：当验证集准确率连续 3 个 epoch 不提升时停止训练
L2 正则化：在损失函数中加入权重平方项

' 修改后的损失计算
Function ComputeLoss(outputs() As Double, targets() As Double, lambda As Double) As Double
    Dim loss As Double
    For i = 1 To output_size
        loss = loss - targets(i) * Log(outputs(i)) - (1 - targets(i)) * Log(1 - outputs(i))
    Next i

    ' 加入 L2 正则化项
    Dim reg_term As Double
    For i = 1 To hidden_size
        For j = 1 To input_size
            reg_term = reg_term + W1(i, j) ^ 2
        Next j
    Next i

    ComputeLoss = loss + 0.5 * lambda * reg_term
End Function

浮点精度问题：
VBA 默认 Double 类型精度 15 位
避免极小学习率（建议 0.01-0.1）

对 Sigmoid 输出做数值裁剪：

If x > 20 Then Sigmoid = 1 ElseIf x < -20 Then Sigmoid = 0

特征工程要点：

必须做 Min-Max 标准化（代码示例）：

Sub NormalizeData(rng As Range)
    Dim min_val As Double, max_val As Double
    min_val = Application.WorksheetFunction.Min(rng)
    max_val = Application.WorksheetFunction.Max(rng)
    For Each cell In rng
        cell.Value = (cell.Value - min_val) / (max_val - min_val)
    Next cell
End Sub