【VBA編】ニューラルネットワーク（ws_Main, G, mdlReadData）

ファイル指定処理

読み込むデータのCSVファイルを指定するコードです。
「ws_Main」シートに記述します。

'[ws_Main - シートオブジェクト]
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim filePath As String
    
    If Target = Range(G.RNG_TRAIN_DATA_PATH) _
        Or Target = Range(G.RNG_TEST_DATA_PATH) Then
        
        Cancel = True
        
        filePath = Application.GetOpenFilename("CSV ファイル,*.csv")
        
        If filePath <> "False" Then
            Target.Value = filePath
        End If
        
    End If
    
End Sub

標準モジュール

標準モジュールで作成する処理です。

定数やグローバル変数の宣言

標準モジュール「G」に以下のコードを書きます。

'[G - 標準モジュール]
Option Explicit

Public Const RNG_TRAIN_DATA_PATH As String = "C2"   '訓練データのパスを格納するセル
Public Const RNG_TEST_DATA_PATH As String = "C3"    'テストデータのパスを格納するセル
Public Const RNG_LEARNING_RATE  As String = "C7"        '学習率を指定するセル
Public Const RNG_MIN_LOSS As String = "C8"                  '学習終了と判断する損失値を指定するセル
Public Const RNG_MAX_EPOCH As String = "C9"                 '最大何回学習するか（エポック数）を指定するセル
Public Const RNG_ACT_HIDDEN As String = "C10"           '隠れ層の活性化関数を指定するセル
Public Const RNG_ACT_OUTPUT As String = "C11"           '出力層の活性化関数を指定するセル
Public Const RNG_W_LOAD As String = "C13"                   '重みの値をロードするかどうかを指定するセル
Public Const RNG_TRAIN_CORRECT_COUNT As String = "F7"   '訓練時の正解数を格納するセル

Public Enum RW
    DATA_TITLE = 1              'データのタイトル行
    DATA_START = 2             'データの開始行
End Enum

Public Enum CL
    DATA_LABEL = 1              'データのラベル列
    DATA_START = 2             'データの開始列

    RESULT_LABEL = 1        '結果のラベル列
    RESULT_ANSWER = 2       '結果の答え列（ニューラルネットの答え）
    RESULT_RATE = 3             '答えの自信度列
    RESULT_TF = 4               '答えが正解かどうかを表す列
    
    LOSS_ = 11                      '損失関数の値
    LOSS_CORRECT = 12       '正解数

End Enum

'活性化関数の種類
Public Const VAL_ACT_ReLU As String = "ReLU"
Public Const VAL_ACT_Softmax As String = "Softmax"

'活性化関数の種類インデックス
Public Enum ACT
    ReLU = 1
    Softmax = 2
End Enum

'Irisの種類名
Public Const VAL_SETOSA As String = "Iris-setosa"
Public Const VAL_VERSICOLOR As String = "Iris-versicolor"
Public Const VAL_VIRGINICA As String = "Iris-virginica"

'Irisの種類インデックス
Public Enum IRIS
    SETOSA = 1
    VERSICOLOR = 2
    VIRGINICA = 3
End Enum

Public UnitCount_IN As Long         '入力層のユニット数
Public UnitCount_OUT As Long        '出力層のユニット数
Public UnitCount_H1 As Long         '隠れ層１のユニット数
Public UnitCount_H2 As Long         '隠れ層２のユニット数

Public LearningRate As Double       '学習率

データの読み込み

'[mdlReadData - 標準モジュール]
Option Explicit

'データの読み込み
Public Sub Click_データ読み込み()
    Dim filePath As String
    
    Application.ScreenUpdating = False
    
    '訓練データの読み込み
    filePath = Range(G.RNG_TRAIN_DATA_PATH).Value
    Call readData(ws_Train_Data, filePath)
    '訓練データを標準化する
    Call standardizeData(ws_Train_Data, ws_Train_Data_Input)

    
    'テストデータの読み込み
    filePath = Range(G.RNG_TEST_DATA_PATH).Value
    Call readData(ws_Test_Data, filePath)
    'テストデータを標準化する
    Call standardizeData(ws_Test_Data, ws_Test_Data_Input)

    Application.ScreenUpdating = True
    
    MsgBox "データを読み込みました。", vbOKOnly + vbInformation
    
End Sub

'データを読み込んで書き込み先のワークシートに書き込む
'[引数] <- aWsData : Worksheet / 読み込んだデータを書き込む先のシート, aFilePath : String / CSVデータのファイル名
'[戻り値] -> なし
Private Sub readData(ByRef aWsData As Worksheet, ByRef aFilePath As String)
    Dim fileNo As Long
    Dim r As Long
    Dim i As Long
    Dim data As String
    Dim datas() As String
    Dim dataLength As Long
    Const DELIMITER As String = ","
    
    With aWsData
    
        .Cells.Clear
        
        r = 1
        fileNo = FreeFile
        Open aFilePath For Input As #fileNo
            Do Until EOF(1)
                Line Input #fileNo, data
                datas = Split(data, DELIMITER)
                dataLength = UBound(datas)
                
                'splitはoption base 1の影響を受けないのでインデックスは0からスタート
                For i = 0 To dataLength
                    .Cells(r, i + 1).Value = datas(i)
                Next
                
                r = r + 1
            Loop
        Close #fileNo
    
    End With
    
End Sub

'ワークシートのデータを標準化して書き込み先のワークシートに書き込む
'[引数] <- aWsData : Worksheet / 元データがあるシート, aWsStandardized : Worksheet / 標準化したデータを書き込む先のシート
'[戻り値] -> なし
Private Sub standardizeData(ByRef aWsData As Worksheet, ByRef aWsStandardized As Worksheet)
    Dim r As Long
    Dim c As Long
    Dim i As Long
    Dim eRow As Long
    Dim eCol As Long
    Dim mean As Double                           '平均値
    Dim std As Double                               '標準偏差
    
    aWsStandardized.Cells.Clear
    
    With aWsData
    
        '最終行と最終列を取得する
        eRow = .Cells(Rows.count, 1).End(xlUp).Row
        eCol = .Cells(1, Columns.count).End(xlToLeft).Column
        
        '列ごとに処理
        For c = CL.DATA_START To eCol
            
            '平均値と標準偏差を求める
            mean = WorksheetFunction.Average(.Range(.Cells(RW.DATA_START, c), .Cells(eRow, c)).Value)
            std = WorksheetFunction.StDev_P(.Range(.Cells(RW.DATA_START, c), .Cells(eRow, c)).Value)
            
            '標準化を行う
            For r = RW.DATA_START To eRow
                aWsStandardized.Cells(r, c).Value = WorksheetFunction.Standardize(CDbl(.Cells(r, c).Value), mean, std)
            Next
            
        Next
        
        'タイトル行とラベル列をコピー貼り付け
        .Rows(RW.DATA_TITLE).Copy Destination:=aWsStandardized.Rows(RW.DATA_TITLE)
        .Columns(CL.DATA_LABEL).Copy Destination:=aWsStandardized.Columns(CL.DATA_LABEL)
        
    End With
    
End Sub