Di nuovo scomparso il tasto edit O.o non vorrei fare multi post ma non so come editare, dopo un tot mi scompare il tasto edit.
Allora, ricominciamo da capo.
Ho capito perché andava in loop, in pratica il codice era impostato che nel mentre copiava le risposte a nelle celle random F,G,H,I, ovviamente alla fine del ciclo ogni volta controllava se la cella dove avrebbe dovuto inserire la risposta fosse già occupata, in caso positivo ripeteva, nel caso dell'inserimento della nuova riga di codice, lui andava a mettere la lettera della presunta posizione della risposta esatta nella cella F e di conseguenza la 4 risposta non aveva più dove metterla perchè si trovava le celle sempre tutte piene e andava in loop.
E' bastato aggiungere un +1 alla riga di codice:
- Codice: Seleziona tutto
Range("A1").Offset(0, NumRisp + 1).Range(ColRisp).Select
facendogli considerare non più F,G,H,I bensì G,H,I,J
e poi invece di +1 un bel +2 nella riga di codice:
- Codice: Seleziona tutto
WOFF = Int(Rnd * NumRisp + NumRisp + 2)
in modo tale che anche quando va a posizionare le risposte nelle nuove caselle tiene conto del fatto che deve iniziare da G e non da F.
Fin qui tutto ok, l'unica cosa che ho notato è che quella riga di codice che mi hai fatto aggiungere per trovare dove sta la risposta esatta, funziona pure solo che in F (ora funziona bene dato che gli ho liberato la cella) non mi mette il nome della cella dove si trova la nuova risposta esatta, bensì la cella prima.
Esempio:
_A_|_B_|_C_|_D_|_E_|_F_|_G_|_H_|_I_|_J_|
2+2|_4_|_3_|_5_|_6_|_G_|_3_|_2_|_6_|_5_|Evvai sono riuscito ad editare, comunque funziona, basta modificare anche questo parametro nella riga di codice:
- Codice: Seleziona tutto
If ActiveCell.Value = Range("A1").Offset(OVert, 1).Value Then Range("A1").Offset(OVert, 5) = Chr(64 + WOFF) '<<< AGGIUNGERE
Al posto del 64 basta mettere 65.
GRAZIE MILLE
Questo è il codice completo da copiare ed incollare.
Codice per mischiare numero 4 risposte multiple e tenere conto di dove viene posizionata la risposta esatta (funziona solo se le risposte esatte della scheda sorgente sono tutte le A)
- Codice: Seleziona tutto
Sub Mischia()
ColRisp = "B:E" '<<<< Modificare a piacere
Dest_WS = "Questions" '<<<<
NumRisp = Range(ColRisp).Columns.Count
Sorg_WS = Range("A1").Worksheet.Name
If Sorg_WS = Dest_WS Then
MsgBox ("Foglio di Origine E' UGUALE a quello di Copia; errore")
Exit Sub
End If
'
'Azzera foglio Destinazione
Sheets(Dest_WS).Select
Cells.Select
Selection.Clear
'Copia i dati su altro foglio
Sheets(Sorg_WS).Select
Cells.Select
Selection.Copy
Sheets(Dest_WS).Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Offset(0, NumRisp + 1).Range(ColRisp).Select
Selection.Clear
Range("A1").Select
'
URiga = Range("A65356").End(xlUp).Row
Randomize
For OVert = 0 To URiga
For OHor = 1 To NumRisp
Riprova:
WOFF = Int(Rnd * NumRisp + NumRisp + 2)
Range("A1").Offset(OVert, OHor).Copy
Range("A1").Offset(OVert, WOFF).Select
If ActiveCell.Value <> "" Then GoTo Riprova: 'Riprova se cella gia' occupata
ActiveSheet.Paste
If ActiveCell.Value = Range("A1").Offset(OVert, 1).Value Then Range("A1").Offset(OVert, 5) = Chr(65 + WOFF) '<<< AGGIUNGERE
Next OHor
Next OVert
'Cancella le risposte originali
Columns(ColRisp).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
MsgBox ("Completato; cancellare se necessario foglio di origine")
End Sub
P.S. mi togli una curiosità? Premettendo che non so scrivere codici per excel, perché poi hai scritto 64? da dove è uscito sto numero? sono curioso, le altre cose le ho più o meno capite ma questa non ci arrivo.