Autres Macro VBA avec un test.
- Initiateur de la discussion ALEA()
- Date de début
Bonjour,
Ceci:
Cdlt
Ceci:
Code:
Sub Remplissage()
Dim i As Long, Nb As Long
Application.ScreenUpdating = False
Range("U2:AE1001").ClearContents
Range("AD2:AD1001").FormulaR1C1 = "=IF(SUMPRODUCT(COUNTIF(RC[-9]:RC[-1],R1C[5]:R1C[19]))>2,1,0)"
For i = 2 To 1001
Nb = 0
Do While Cells(i, "AD") <> 1
Range(Cells(i, "U"), Cells(i, "AC")).FormulaR1C1 = "=RANDBETWEEN(1,100)"
Nb = Nb + 1
Loop
Range(Cells(i, "U"), Cells(i, "AC")).Value = Range(Cells(i, "U"), Cells(i, "AC")).Value
Cells(i, "AE") = Nb
Next i
End SubCdlt
OlivGM
XLDnaute Occasionnel
Bonjour à tous,
Je regarde cette réponse qui m'intéresse !!!! mais" Rand between "ne va pas fournir des doublons dans la série des 8 nombres? Juste pour info
Je regarde cette réponse qui m'intéresse !!!! mais" Rand between "ne va pas fournir des doublons dans la série des 8 nombres? Juste pour info
Bonjour OlivGM,
Sauf mauvaise interprétation de ma part, mais Alea() n'a pas spécifié s'il pouvait y avoir des doublons ou pas.
Sauf mauvaise interprétation de ma part, mais Alea() n'a pas spécifié s'il pouvait y avoir des doublons ou pas.
Suite à la remarque de OlivGM, voici une autre version qui ne renvois pas de doublons.
VB:
Sub Remplissage()
Dim i As Long, Nb As Long, j as long
Application.ScreenUpdating = False
Range("U2:AE1001").ClearContents
Range("AD2:AD1001").FormulaR1C1 = "=IF(SUMPRODUCT(COUNTIF(RC[-9]:RC[-1],R1C[5]:R1C[19]))>2,1,0)"
For i = 2 To 1001
Nb = 1
Recommence:
Do
Range(Cells(i, "U"), Cells(i, "AC")).FormulaR1C1 = "=RANDBETWEEN(1,100)"
Range(Cells(i, "U"), Cells(i, "AC")).Value = Range(Cells(i, "U"), Cells(i, "AC")).Value
For j = 22 To 29
If Application.CountIf(Range(Cells(i, "U"), Cells(i, "AC")), Cells(i, j)) > 1 Then
Nb = Nb + 1
GoTo Recommence
End If
Next j
Loop While Cells(i, "AD") <> 1
Cells(i, "AE") = Nb
Next i
End Sub
Dranreb
XLDnaute Barbatruc
Bonjour.
Ma version :
Avant de tenter l'exécution, glissez/déplacez le module de classe ListeAléat depuis le projet VBA du classeur joint.
Ma version :
VB:
Option Explicit
Sub Tirages()
Dim LAt As New ListeAléat, TRéf(), TOK(1 To 100) As Byte, TRés(1 To 1000, 1 To 11), L&, C&, P&, NbOk, NbTent As Long
TRéf = Feuil1.[AI1:AW15].Value
For C = 1 To UBound(TRéf, 2): TOK(TRéf(1, C)) = 1: Next C
Randomize
For L = 1 To 1000
NbTent = 0
Do: NbTent = NbTent + 1
LAt.Init 100
NbOk = 0
For P = 1 To 9: NbOk = NbOk + TOK(LAt.Aléat(P)): Next P
Loop Until NbOk > 2
For C = 1 To 9: TRés(L, C) = LAt.Aléat(C): Next C
TRés(L, 11) = NbTent
Next L
Feuil1.[U2:AE1001].Value = TRés
Feuil1.[AD2:AD1001].FormulaR1C1 = "=IF(SUMPRODUCT(COUNTIF(RC21:RC29,R1C35:R1C49))>2,1,0)"
End SubBonjour,
Je vais tester vos 2 versions VBA.
PS: Dranreb, comme je ne sais pas ce qu'est un module de classe, j'ai inséré ton code basic dans ton classeur ListeAléat que tu m'as envoyé mais ça ne fonctionne pas....erreur execution 9 à Next C ??
Bon am
Je vais tester vos 2 versions VBA.
PS: Dranreb, comme je ne sais pas ce qu'est un module de classe, j'ai inséré ton code basic dans ton classeur ListeAléat que tu m'as envoyé mais ça ne fonctionne pas....erreur execution 9 à Next C ??
Bon am
Dranreb
XLDnaute Barbatruc
C'est parce qu'elle est vide la feuille "Feuil1" représentée par l'objet Worksheet Feuil1 donc pas de numéro entre 1 et 100 en Feuil1.[AI1:AW15].
Un module de classe sert à définir un type d'objet personnalisé avec ses méthodes et propriétés.
Mais ne pas l'avoir su n'aurait pas dû vous empêcher de trainer son nom avec la souris, bouton gauche maintenu enfoncé, vers le projet VBA de votre classeur dans l'explorateur de projets.
Un module de classe sert à définir un type d'objet personnalisé avec ses méthodes et propriétés.
Mais ne pas l'avoir su n'aurait pas dû vous empêcher de trainer son nom avec la souris, bouton gauche maintenu enfoncé, vers le projet VBA de votre classeur dans l'explorateur de projets.
Dernière édition:
