Hallo, 

ich möchte ein altes Excel-Rätsel aus dem Jahr 2006 wiederbeleben. Leider läuft das Makro in Excel 2016 nicht mehr. Es stockt an der unten gelb markierten Postition. 

Kann jemand helfen?

Vielen Dank

Kristiane 

************************************

Sub Gesamttest_auswerten()

    ActiveSheet.Unprotect Password:=Sheets(Sheets.Count).Cells(2, 12)

    ActiveSheet.Cells(39, 2) = ""

    Dim richtig(9) As Integer
    Dim zähler(9) As Integer
    ergebnis = 0
    gesamtaufgaben = 0
    blatt = 0

    For i = 0 To 9
        richtig(i) = 0
        zähler(i) = 0
    Next

    For i = 0 To Sheets.Count - 2

        For j = 0 To 9
    
            'Gesamtzahl der Fragen ermitteln
            If Not Sheets(i + 1).Cells(8 + j * 17, 4) = 0 Then gesamtzahl = gesamtzahl + 1
    
            'Einzelantworten bestimmen
            Sheets(i + 1).OLEObjects("klar" & j).Object.Value = True
            If Sheets(i + 1).Cells(16 + j * 17, 9) = Sheets(Sheets.Count).Cells(4, 12) Then
                richtig(i) = richtig(i) + 1
            End If
        
            'zählen wie viele Antworten insgesamt ausgewählt wurden
            If Sheets(i + 1).OLEObjects("a" & j).Object.Value Then zähler(i) = zähler(i) + 1
            If Sheets(i + 1).OLEObjects("b" & j).Object.Value Then zähler(i) = zähler(i) + 1
            If Sheets(i + 1).OLEObjects("c" & j).Object.Value Then zähler(i) = zähler(i) + 1
        
        Next
    
        gesamtaufgaben = gesamtaufgaben + zähler(i)
    
        'Summe der Teilergebnisse zählen
        If zähler(i) > 0 Then
            ergebnis = ergebnis + richtig(i) / zähler(i)
            blatt = blatt + 1
        End If
 
        Sheets(Sheets.Count).Cells(5 + i * 3, 17) = zähler(i)
        Sheets(Sheets.Count).Cells(6 + i * 3, 17) = richtig(i)
    
    Next

    'Durschnitt der Teilergebnisse bilden
    If blatt > 0 Then ergebnis = ergebnis / blatt Else ergenis = 0
    
    'Antwortblock wählen, denn dieser ist abhängig von der Gesamtzahl der Antworten
    If summe < gesamtzahl Then block = 0 Else block = 1

    'Auswertungstext auswählen
    If Not gesamtaufgaben = 0 Then
        Select Case ergebnis
            Case Is <= 0.2: Sheets(Sheets.Count).Cells(39, 2) = Sheets(Sheets.Count).Cells(8 + 17 * block, 12)
            Case Is <= 0.4: Sheets(Sheets.Count).Cells(39, 2) = Sheets(Sheets.Count).Cells(11 + 17 * block, 12)
            Case Is <= 0.6: Sheets(Sheets.Count).Cells(39, 2) = Sheets(Sheets.Count).Cells(14 + 17 * block, 12)
            Case Is <= 0.8: Sheets(Sheets.Count).Cells(39, 2) = Sheets(Sheets.Count).Cells(17 + 17 * block, 12)
            Case Else: Sheets(Sheets.Count).Cells(39, 2) = Sheets(Sheets.Count).Cells(20 + 17 * block, 12)
        End Select
    End If

    ActiveSheet.Protect Password:=Sheets(Sheets.Count).Cells(2, 12)

End Sub