Sub StarteEingabe()

Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim zeilenzaehler1 As Integer
zeilenzaehler1 = 0
Dim inputKorrektEingegeben As Boolean
inputKorrektEingegeben = False        

Do While inputKorrektEingegeben = False
        Dim myInput As Range
        Set myInput = Application.InputBox("Gib deine Inputvariablen als Range an (Spalten=Variablen, Zeilen=Fälle)", "Input", 0, , , , , 8)
        inputKorrektEingegeben = True 'vorläufig wird Input als korrekt eingegeben klassifiziert
            Dim i0 As Integer
            For i0 = 1 To (myInput.Areas.Count) ' Gehe alle gewählten Ranges durch und zähle jeweils die Zeilen (Fälle):
                Dim zeilenzaehler As Integer
                zeilenzaehler = Intersect(myInput.Areas(i0).SpecialCells(xlVisible), myInput.Areas(i0).Columns(1)).Count
                'MsgBox "Area " & i0 & " hat " & zeilenzaehler & " Zeilen (letzte Zeilenzahl=" & zeilenzaehler1 & ")", vbInformation, "Zeilenzählung"
                If (zeilenzaehler <> zeilenzaehler1) And i0 > 1 Then 'wenn eine Range, die nicht die erste ist, eine andere Zeilenzahl als die erste aufweist:
                    inputKorrektEingegeben = False
                    MsgBox "Die gewählten Bereiche enthalten unterschiedlich viele Fälle/Zeilen"
                End If
                zeilenzaehler1 = zeilenzaehler
            Next i0                    
            Dim faelle As Integer
                faelle = zeilenzaehler1
Loop    

Dim outputKorrektEingegeben As Boolean
Do While outputKorrektEingegeben = False
        Dim myOutput As Range
        Set myOutput = Application.InputBox("Gib deine Outputvariablen als Range an (Spalten=Variablen, Zeilen=Fälle)", "Output", 0, , , , , 8)
        outputKorrektEingegeben = True 'vorläufig wird Output als korrekt eingegeben klassifiziert
            For i0 = 1 To (myOutput.Areas.Count) ' gehe alle Ranges durch und zähle jeweils die Zeilen (Fälle):
                zeilenzaehler = Intersect(myOutput.Areas(i0).SpecialCells(xlVisible), myOutput.Areas(i0).Columns(1)).Count
                'MsgBox "Area " & i0 & " hat " & zeilenzaehler & " Zeilen (geforderte Zeilenzahl=" & faelle & ")", vbInformation, "Zeilenzählung"
                If (zeilenzaehler <> faelle) Then 'wenn eine Range, eine andere Zeilenzahl aufweist als die Inputranges:
                    outputKorrektEingegeben = False
                    MsgBox "Die gewählten Bereiche enthalten nicht ebenso viele Fälle/Zeilen wie die Inputvariablen"
                End If
            Next i0
Loop

 'Speichere den Sheet, von dem die Daten stammen
    Dim QuellenName As String
        QuellenName = ActiveSheet.Name
             
' Zähle nun die Anzahl der Input- und Outputvariablen
    Dim inputs As Integer
        inputs = 0
            For i0 = 1 To (myInput.Areas.Count)
                inputs = inputs + Intersect(myInput.Areas(i0).SpecialCells(xlVisible), myInput.Areas(i0).Rows(1)).Count 'Spalten via "Intersect.Count" zählen (wie viele elemente meiner auswahl sind mit den elementen der ersten Zeile identisch)
            Next i0
    Dim outputs As Integer
        outputs = 0
            For i0 = 1 To (myOutput.Areas.Count)
                outputs = outputs + Intersect(myOutput.Areas(i0).SpecialCells(xlVisible), myOutput.Areas(i0).Rows(1)).Count 'Spalten via "Intersect.Count" zählen (wie viele elemente meiner auswahl sind mit den elementen der ersten Zeile identisch)
            Next i0

' Schreibe die -u.U. unzusammenhängenden Outputarrays in ein Zahlenarray:
    ReDim idealValue(outputs, faelle) As Double
        i1 = 1
        For i0 = 1 To (myOutput.Areas.Count)
            For i2 = 1 To Intersect(myOutput.Areas(i0).SpecialCells(xlVisible), myOutput.Areas(i0).Rows(1)).Count 'Spalten zählen
                i4 = 1
                For i3 = 1 To Intersect(myOutput.Areas(i0).SpecialCells(xlVisible), myOutput.Areas(i0).Columns(1)).Count 'Reihen zählen
                    idealValue(i1, i4) = Sheets(QuellenName).Range(Intersect(Intersect(myOutput.Areas(i0).SpecialCells(xlVisible), myOutput.Areas(i0).Rows(i3)), myOutput.Areas(i0).Columns(i2)).Address)
                    i4 = i4 + 1
                Next i3
                i1 = i1 + 1
            Next i2
        Next i0


' Schreibe die -u.U. unzusammenhängenden Inputarrays in ein Zahlenarray:
    ReDim inputValue(inputs, faelle) As Double
        i1 = 1
        For i0 = 1 To (myInput.Areas.Count)
            For i2 = 1 To Intersect(myInput.Areas(i0).SpecialCells(xlVisible), myInput.Areas(i0).Rows(1)).Count 'Spalten zählen
                i4 = 1
                For i3 = 1 To Intersect(myInput.Areas(i0).SpecialCells(xlVisible), myInput.Areas(i0).Columns(1)).Count 'Reihen zählen
                    inputValue(i1, i4) = Sheets(QuellenName).Range(Intersect(Intersect(myInput.Areas(i0).SpecialCells(xlVisible), myInput.Areas(i0).Rows(i3)), myInput.Areas(i0).Columns(i2)).Address)
                    i4 = i4 + 1
                Next i3
                i1 = i1 + 1
            Next i2
        Next i0

        
' Nachdem sowohl die Fallzahlen als auch die Anzahl der Input- u. Outputunits feststeht, melde dich:
    MsgBox "Inputvariablen=" & inputs & Chr(13) & "Outputvariablen=" & outputs & Chr(13) & "Fälle=" & faelle



Dim epsilon As Double
epsilon = 0.01
ReDim weightValue(inputs, outputs) As Double
ReDim weightSammlung(inputs, outputs) As Double
ReDim actualValue(outputs, faelle) As Double
ReDim deltaValue(outputs, faelle) As Double
                
'Initialisiere Netz-Gewichte
For i4 = 1 To inputs
    For i2 = 1 To outputs
          weightValue(i4, i2) = 0 ' oder auch: Rnd
          weightSammlung(i4, i2) = 0
    Next i2
Next i4
                


'Rechne das Neuronale Netz
For i0 = 1 To 3000 'für alle Epochen
    For i3 = 1 To faelle 'für jedes Pattern
        For i2 = 1 To outputs 'für jede Outputunit
            
            'bestimme den actual output:
            actualValue(i2, i3) = 0
            For i4 = 1 To inputs 'für jede Inputunit
                actualValue(i2, i3) = actualValue(i2, i3) + weightValue(i4, i2) * inputValue(i4, i3)
            Next i4 ' nach der Summation aller Inputwerte entspricht der actual-output dem netto-input
    
            ' Bestimme Delta und die Gewichtsveränderungen:
            deltaValue(i2, i3) = idealValue(i2, i3) - actualValue(i2, i3)
            For i4 = 1 To inputs 'für jede Inputunit
                'verändere gewichte hypothetisch:
                weightSammlung(i4, i2) = weightSammlung(i4, i2) + deltaValue(i2, i3) * inputValue(i4, i3) * epsilon 'If i3 = 1 Then MsgBox "Epoche " & i0 & Chr(13) & "Pattern " & i3 & Chr(13) & "weight(" & i4 & "," & i2 & ")=" & weightValue(i4, i2) & Chr(13) & "input=" & inputValue(i4, i3) & " ideal =" & idealValue(i2, i3) & " actual=" & actualValue(i2, i3) & " delta=" & deltaValue(i2, i3) & Chr(13) & "Delta_w=" & (deltaValue(i2, i3) * inputValue(i4, i3) * epsilon)
            Next i4 'inputunits
        Next i2 'outputunits
    Next i3 'patterns
    
    'Am Ende jeder Epoche verändere die Gewichte tatsächlich Batch-training)
    For i2 = 1 To outputs 'für jede Outputunit
        For i4 = 1 To inputs 'für jede Inputunit
            weightValue(i4, i2) = weightValue(i4, i2) + weightSammlung(i4, i2)
            weightSammlung(i4, i2) = 0
        Next i4
    Next i2
    
Next i0 'Epochen





' Neue Tabelle anlegen:   
    Dim TableName As String
        TableName = Left$(ActiveSheet.Name, Len(ActiveSheet.Name) - 1)
    Dim cnt As Integer
        cnt = Worksheets.Count
    Worksheets.Add after:=Worksheets(Worksheets.Count) 'Füge neue Tabelle ein
    ActiveSheet.Name = "Tabelle" & (CStr(cnt) + 1) & "(NN)"  'benenne die neue Tabelle
    TableName = ActiveSheet.Name
                                                                                'Range("A1").End(xlToRight).Select 'letzte Zelle einer Zeile finden

' Spalten für Gewichte anlegen:    
     Range("A2").Select ' Wähle die erste Zelle der zweiten Zeile in der neuen Tabelle als aktive aus
     For i0 = 1 To outputs
        ActiveCell.EntireColumn.Insert 'Füge für jede outputvariable eine Spalte ein (verschiebe andere spalten nach links)
     Next i0
     Dim myWeights As Range 'benenne die relevante Range der soeben eingefügte Spalte:
        Set myWeights = Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row + inputs - 1, ActiveCell.Column + outputs - 1))
     
     For i2 = 1 To outputs 'für jede Outputunit
        For i4 = 1 To inputs 'für jede Inputunit
            Sheets(TableName).Range(Intersect(Intersect(myWeights.SpecialCells(xlVisible), myWeights.Rows(i4)), myWeights.Columns(i2)).Address).Value = weightValue(i4, i2) 'Übertrage errechnete Gewichte in die tabelle
        Next i4
     Next i2


' Wenn alles fertig ist, melde dich:
    MsgBox "Fertig!"
    
End Sub