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
Registrazione
