Salve ragazzi, sono nuovo nel forum e avrei bisogno del vosto aiuto.
Devo studiare per un concorso e ho bisogno di mescolare le 5000 domande in modo casuale.
Il file in questione è il seguente: http://www.filedropper.com/bancadati
Moderatori: Anthony47, Flash30005
Sub Mischia()
Dim uRiga As Long, Nome As String
Dim Risposta As Integer
Nome = ActiveSheet.Name
Application.ScreenUpdating = False
Dim sh1 As Worksheet: Set sh1 = Worksheets(Nome)
uRiga = sh1.Range("A" & Rows.Count).End(xlUp).Row
sh1.Range("D2:G" & uRiga).Interior.Pattern = xlNone
sh1.Range("H2:H" & uRiga).ClearContents
sh1.Range("A1,H1") = ""
Risposta = MsgBox(prompt:="Desideri mischiare le colonne?", Buttons:=vbYesNo)
Dim iRow As Long
Dim iCol As Long
Dim Temp As String
Dim Cas As Integer
If Risposta = vbYes Then
For iRow = 2 To uRiga
For iCol = 1 To 4
Randomize Timer
Cas = Int(Rnd * 4) + 1
Temp = Cells(iRow, iCol + 3)
sh1.Cells(iRow, iCol + 3) = sh1.Cells(iRow, Cas + 3)
sh1.Cells(iRow, Cas + 3) = Temp
If sh1.Cells(1, iCol + 3) = sh1.Cells(iRow, 3) Then
sh1.Cells(iRow, 3) = sh1.Cells(1, Cas + 3)
ElseIf Cells(1, Cas + 3) = sh1.Cells(iRow, 3) Then
sh1.Cells(iRow, 3) = sh1.Cells(1, iCol + 3)
End If
Next
Next
Else
GoTo Righe
End If
Righe:
Risposta = MsgBox(prompt:="Desideri mischiare le righe?", Buttons:=vbYesNo)
If Risposta = vbYes Then
Dim Inizia As Long, I As Long, J As Long, TTemp
Dim Arr()
uRiga = sh1.Range("A" & Rows.Count).End(xlUp).Row - 1
Inizia = 1
ReDim Arr(Inizia To uRiga, 1 To 1)
For I = Inizia To uRiga
Arr(I, 1) = I
Next
For I = uRiga To Inizia Step -1
J = Rnd * (uRiga - Inizia + 1) + Inizia
If J > uRiga Then J = uRiga
TTemp = Arr(I, 1)
Arr(I, 1) = Arr(J, 1)
Arr(J, 1) = TTemp
Next
sh1.Range("A2:A" & (uRiga - Inizia + 2)) = Arr
uRiga = sh1.Range("A" & Rows.Count).End(xlUp).Row
sh1.Sort.SortFields.Clear
sh1.Sort.SortFields.Add Key:=Range("A2:A" & uRiga) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With sh1.Sort
.SetRange Range("A1:I" & uRiga)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Risposta = MsgBox(prompt:="Allargare/restringere la colonna B, attualmente uguale a " & sh1.Columns(2).ColumnWidth, Buttons:=vbYesNo)
Dim X
If Risposta = vbYes Then
X = InputBox("Inserisci nuova valore larghezza", , 0)
sh1.Columns(2).ColumnWidth = X
sh1.Range("D2:G" & uRiga).Rows.AutoFit
End If
Set sh1 = Nothing
Application.ScreenUpdating = True
MsgBox "fatto"
End Sub
=SE(SINISTRA(A2;2)="A)";A2;"")
=SE(SINISTRA(A2;2)="A)";A3;"")
=SE(SINISTRA(A2;2)="A)";A4;"")
=SE(SINISTRA(A2;2)="A)";A5;"")
-Domanda
-risposta giusta
-altra risposta
-altra risposta
-altra risposta
-Domanda
-continuazione domanda
-risposta giusta
-altra risposta
-altra risposta
-altra risposta
-Domanda
-risposta giusta
-riga con meno di 6 crt, da ignorare (posizionata a piacere)
-altra risposta
-altra risposta
-altra risposta
Torna a Applicazioni Office Windows
Montare PC con scheda madre GA-P35-DS4, domande sugli slot,e Autore: binson |
Forum: Assistenza Hardware Risposte: 2 |
Visitano il forum: Nessuno e 11 ospiti