End Sub
Sub Donne()
Dim H As Integer, Min As Integer
Dim Obj As Object: Set Obj = CreateObject("ADODB.Recordset")
Obj.Fields.Append "Order", adInteger, 4
Obj.Fields.Append "Name", adChar, 50
Obj.Fields.Append "Power", adDouble, 18.4
Obj.Open
Dim Joueur As Object: Set Joueur = CreateObject("ADODB.Recordset")
Joueur.Fields.Append "Order", adInteger, 4
Joueur.Fields.Append "Name", adChar, 50
Joueur.Fields.Append "Power", adDouble, 18.4
Joueur.Fields.Append "Joueur", adInteger, 4
Joueur.Open
With Sheets("Feuil1").Range("A2").CurrentRegion
For I = 2 To .Rows.Count
If Trim("" & .Cells(I, "B")) <> "" Then
Obj.AddNew
Obj("Order") = .Cells(I, "A")
Obj("Name") = .Cells(I, "B")
Debug.Print Format(.Cells(I, "C"), "#0.000")
Obj("Power") = .Cells(I, "C")
Obj.Update
End If
Next
End With
Debug.Print Obj.RecordCount
Obj.MoveFirst
Randomize (Split(Format(Timer, "0.000"), ",")(1))
'on ajoute une valeur Min pour filtrer sur ORDER 9a favorise les Pet power (B) les plus elevé!
Min = 4
For I = 1 To 7
Obj.Filter = "Order<=" & Min
Obj.Move Int(Obj.RecordCount * Rnd)
Joueur.AddNew
Joueur("Order") = Obj("Order")
Joueur("Name") = Obj("Name")
Joueur("Power") = Obj("Power")
Joueur("Order") = Obj("Order")
Joueur("Joueur") = "1"
Joueur.Update
P = Split(Obj("Power"), ",")(0)
H = 4.12201154163232E-02 * Obj("Power")
If H < 1 Then H = 1
Obj.Delete
Obj.Update
Obj.Filter = "Power>=" & (P - H) & " AND Power<=" & (P + H)
While Obj.EOF
Obj.Filter = "Power>=" & (P - H) & " AND Power<=" & (P + H)
H = H + 1
Wend
Obj.MoveFirst
Obj.Move Int(Obj.RecordCount * Rnd)
Joueur.AddNew
Joueur("Order") = Obj("Order")
Joueur("Name") = Obj("Name")
Joueur("Power") = Obj("Power")
Joueur("Order") = Obj("Order")
Joueur("Joueur") = 2
Joueur.Update
Obj.Delete
Obj.Update
Obj.Filter = ""
Obj.MoveFirst
Joueur.MoveFirst
DoEvents
Min = Min + 5
Next
Joueur.Sort = "Order"
With Sheets("Analyse")
.Range("A2").CopyFromRecordset Joueur
.Range(.Range("D2"), .Cells(.Rows.Count, "D").End(xlUp)).NumberFormat = """JOUEUR"" 0"
End With
End Sub