A DOMANDA VERIFICA SE LA RISPOSTA E' ESATTA

[robertogiuseppe]

Buongiorno,
sarei grato se qualcuno riuscisse a risolvermi questo problema. Ho un file excel "01 attualita" composto di due fogli di lavoro: uno DOMANDE l'altro RISPOSTE. Ciò che vorrei ottenere è che: cliccando nel foglio di lavoro Domande la risposta che ritengo corretta, mi fosse visualizzata (leggendo nel file RISPOSTE) se è esatta oppure no, questo naturalmente per tutte le domande.
Vi ringrazio anticipatamente per il Vostro interessamento
robertogiuseppe




<a href=http://www.filedropper.com/01attualita><img src=http://www.filedropper.com/download_button.png width=127 height=145 border=0/></a><br /><div style=font-size:9px;font-family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;> <a href=http://www.filedropper.com >online backup</a></div>

[Anthony47]

La struttura del file suggerisce un approccio appena diverso da quanto facemmo un paio di anni fa...
La mia proposta:
-fai tasto dx sul tab col nome nome foglio "DOMANDE"; si aprira' l'editor delle macro
-copia questo codice e incollalo nel frame a destra dell'editor delle mecro:

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myMatch, cResp As String, cQuest As Long, qArea As Range
If Target.Count = 1 Then
    If Target.Column = 2 Then
        If Not IsNumeric(Target.Offset(0, -1).Value) Then
        Set qArea = Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp))
            qArea.Offset(0, 1).Interior.Color = xlNone
            cResp = Left(Target.Offset(0, -1).Value, 1)
            If Asc(cResp) > 64 And Asc(cResp) < 69 Then
                cQr = Evaluate("MAX(IF(ISNUMBER(A1:A" & Target.Row & "),ROW(A1:A" & Target.Row & "),""""))")
                cQuest = Cells(cQr, 1).Value
                myMatch = Application.Match(cQuest, Sheets("RISPOSTE").Range("A1:A10000"), False)
                If Not IsError(myMatch) Then
                    If UCase(Left(Target.Offset(0, -1).Value, 1)) = UCase(Sheets("RISPOSTE").Cells(myMatch, 2)) Then
                        Target.Interior.Color = RGB(0, 255, 0)
                        Cells(cQr, "F") = Cells(cQr, "F") + 1
                        If Cells(cQr, "F") > 4 Then Cells(cQr, "F") = 4
                    Else
                        Target.Interior.Color = RGB(255, 0, 0)
                        Cells(cQr, "F") = Cells(cQr, "F") - 1
                        If Cells(cQr, "F") < -4 Then Cells(cQr, "F") = -4
                    End If
                    If Cells(cQr, "F") >= 0 Then
                        Cells(cQr, "A").Interior.Color = RGB(255 - 60 * Cells(cQr, "F"), 255, 255 - 60 * Cells(cQr, "F"))
                    Else
                        Cells(cQr, "A").Interior.Color = RGB(255, 255 + 60 * Cells(cQr, "F"), 255 + 60 * Cells(cQr, "F"))
                    End If
                   
                End If
            End If
        End If
    End If
End If
End Sub


Torna sul file Excel, e salvalo in formato ".xlsm" (macro enabled)

Vai ora sul foglio Domande e seleziona una cella di colonna B: se corrisponde alla risposta giusta la cella si colora di Verde, altrimenti si colora di Rosso.
Inoltre la cella col numero di domanda vira verso il verde oppure il rosso a seconda che le risposte giuste siano state prevalenti o minoritarie. A questo scopo in colonna F calcolo la somma tra le risposte giuste e quelle sbagliate (da +4 a -4)

Fai s apere...

[robertogiuseppe]

Grazie Anthony47,
a distanza di quasi tre anni dopo che mio figlio è entrato in una Scuola Militare, quest'anno con l'esame di maturità proverà il concorso per entrare in Accademia. Come anni fa spero che questa macro lo aiuti nel concorso.
A presto e le farò sapere come è andata a finire.
robertogiuseppe

[scanacc]