Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

AIUTO CON ORDINE RISPOSTE QUIZ , FILE EXCELL

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

AIUTO CON ORDINE RISPOSTE QUIZ , FILE EXCELL

Postdi wrangler11 » 09/09/17 17:30

buongiorno a tutti,
sono nuovo nel forum , però talvolta leggo qualche topic che può essermi utile.
é tutto il pomeriggio che provo a lavorare su un fil excel del test di medicina in inglese degli altri anni.
Io vorrei modificare l'ordine delle possibili risposte, in quanto al momento le risposte sono tutte A, per poi svolgerlo, altrimenti
servirebbe davvero a poco svolgerlo sapendo già la risposta.
se avete bisogno vi allego i file Excel , magari voi potete aiutarmi , grazi in anticipo !
wrangler11
Newbie
 
Post: 3
Iscritto il: 09/09/17 17:14

Sponsor
 

Re: AIUTO CON ORDINE RISPOSTE QUIZ , FILE EXCELL

Postdi Anthony47 » 09/09/17 23:45

Abbiamo gia' avuto quesiti analoghi per i concorsi piu' vari, se alleghi il file excel con le domande e le risposte possiamo adattare quel che abbiamo.
Per le istruzioni su come allegare un file:
viewtopic.php?f=26&t=103893&p=605487#p605487

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 18203
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: AIUTO CON ORDINE RISPOSTE QUIZ , FILE EXCELL

Postdi wrangler11 » 10/09/17 18:25

Grazie mille , allego subito allora , come faccio ?
wrangler11
Newbie
 
Post: 3
Iscritto il: 09/09/17 17:14

Re: AIUTO CON ORDINE RISPOSTE QUIZ , FILE EXCELL

Postdi wrangler11 » 10/09/17 18:49

ho trovato il modo scusate , non avevo letto il topic precedente !
questi sono i tre file excel dei quali mi servirebbe che le risposte alle domande venissero mischiate , grazie ! <a

href=http://www.filedropper.com/imat2012><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 >upload files online</a></div>

<a href=http://www.filedropper.com/imat2013><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 >file upload storage</a></div>

<a href=http://www.filedropper.com/imat2015-2><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 >upload files online</a></div>
wrangler11
Newbie
 
Post: 3
Iscritto il: 09/09/17 17:14

Re: AIUTO CON ORDINE RISPOSTE QUIZ , FILE EXCELL

Postdi Anthony47 » 11/09/17 14:00

Guardando il contenuto dei file mi ha preso lo sconforto:
-alcuni fogli contengono solo la domanda e le risposte sono sul foglio successivo
-in alcuni fogli la domanda e' suddivisa su due fogli e le risposte su un terzo
-in alcuni casi la domanda e' suddivisa su tre fogli e le risposte su un quarto
-in alcuni fogli ci sono la domanda e le risposte
-in qualche foglio ci sono Domande e Risposte, Seconda domanda
-non c'e' nulla che possa automaticamente garantire accorpamenti accurati delle domande, se sparpagliate su piu' fogli, e accoppiarle con le sue risposte.
Insomma una organizzazione "a caso".

In questa circostanza non si puo' che procedere col noto criterio di "shit in, shit out".

Pertanto:
Aggiungi in coda al tuo file un foglio vuoto, e assegnagli il nome "PIPPO"
Inserisci in un "modulo standard del vba" questa macro:
Codice: Seleziona tutto
Sub SHinSHout()
Dim dSh As Worksheet, nextR As Long, nextC As Long, NSTop As Long
Dim Answ As Boolean, I As Long, J As Long, K As Long, aCaso
'
Set dSh = Sheets("pippo")
dSh.Cells.Clear
dSh.Select
For I = ActiveSheet.Shapes.Count To 1 Step -1
    ActiveSheet.Shapes(I).Delete
Next I
aCaso = Array(Rnd(), Rnd(), Rnd(), Rnd(), Rnd())
'
nextR = 1
For I = 1 To Worksheets.Count - 1
    Sheets(I).Activate
    dSh.Cells(nextR, 1) = ActiveSheet.Name: nextR = nextR + 1
    NSTop = nextR
    Range("A1").Select
    Answ = False
    For J = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        nextC = 1
        If Left(ActiveSheet.Cells(J, 1), 1) = "A" And Left(ActiveSheet.Cells(J + 1, 1), 1) = "B" Then
            Answ = True
            crnum = J
'            nextC = nextC + 1
            aCaso = Array(Rnd(), Rnd(), Rnd(), Rnd(), Rnd())
        End If
        mmax = Application.WorksheetFunction.Max(aCaso)
        mmatch = Application.WorksheetFunction.Match(mmax, aCaso, 0)
        For K = 1 To Cells(J, 100).End(xlToLeft).Column
            If Answ Then
                aCaso(mmatch - 1) = 0
                If Cells(crnum + mmatch - 1, K) <> "" Then Cells(crnum + mmatch - 1, K).Copy dSh.Cells(nextR, nextC + 1)
                fcar = Asc(Left(dSh.Cells(nextR, nextC + 1), 1))
                If nextC = 1 And fcar > 64 And fcar < 70 Then
                    dSh.Cells(nextR, 1) = nextR + fcar
                    dSh.Cells(nextR, nextC + 1) = Replace(dSh.Cells(nextR, nextC + 1), Chr(fcar), "*", , 1, vbTextCompare)
                End If
                nextC = nextC + 1
            Else
                If Cells(J, K).Value <> "" Then Cells(J, K).Copy dSh.Cells(nextR, nextC)
                nextC = nextC + 1
            End If
        Next K
        If J > 1 Then
            If Left(Cells(J, 1), 1) = "E" And Left(Cells(J - 1, 1), 1) = "D" Then Answ = False
        End If
        nextR = nextR + 1
    Next J
'Copia eventuali immagini:

For J = 1 To ActiveSheet.Shapes.Count
Application.ScreenUpdating = False
Application.EnableEvents = False
    If J = 1 Then tlr = ActiveSheet.Shapes(J).TopLeftCell.Row
    ActiveSheet.Shapes(J).Copy
    Sheets("pippo").Select
    Cells(NSTop, 1).Offset(tlr - 1, 5 + 4 * J).Select
    ActiveSheet.Paste
    Sheets(I).Select
Next J
Application.ScreenUpdating = True
Application.EnableEvents = True
Next I
MsgBox ("Compilato foglio PIPPO")
dSh.Select: Range("A1").Select
End Sub

Operativamente, partendo dal file Excel:
-premi Alt-F11 per aprire l'editor delle macro
-Menu /Inserisci /Modulo
-Copia il codice e incollalo nel frame dx del modulo appena creato

Torna su Excel, fai tasto dx sul tab col nome PIPPO:
-scegli Visualizza codice
-copia questo codice e incollalo sul frame vuoto che si e' aperto
Codice: Seleziona tutto
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("B1:B10000").Interior.Color = xlNone
    If Target.Column = 2 And Target.Value <> "" Then
        If Target.Row + 65 = Target.Offset(0, -1).Value Then
            Target.Interior.Color = RGB(0, 255, 0)
        Else
            Target.Interior.Color = RGB(255, 0, 0)
        End If
    End If
End Sub

A questo punto torna su Excel e salva il file in formato xlsm (macro enabled).
Infine esegui la macro SHinSHout:
-premi Alt-F8
-seleziona SHinSHout dall'elenco di macro disponibili
-premi Esegui

In questo modo il foglio PIPPO dovrebbe essere stato popolato con l'elenco di domande (coerente con la filosofia shit in, shit out) e relative risposte.
Le immagini trovate nei fogli sorgenti saranno copiate "nei pressi" delle domande; ma se il foglio sorgente ci sono piu' domande le immagini saranno posizionate accanto alla prima domanda.

Scrorri le domande e seleziona la colonna B di quella che credi sia la risposta corretta: se Ok la cella si colora di verde, altrimenti di Rosso.

Ripeti il processo su tutti i file.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 18203
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "AIUTO CON ORDINE RISPOSTE QUIZ , FILE EXCELL":

file audio /link html
Autore: nikita75
Forum: Software Windows
Risposte: 0
Richiesta aiuto macro VBA
Autore: mara26
Forum: Programmazione
Risposte: 1

Chi c’è in linea

Visitano il forum: raimea e 46 ospiti

cron