Autres Macro VBA avec un test.

[ALEA()]

Bonjour,

Je souhaiterais un code macro "VBA" pour écrire 8 nombres avec un test (je le fais par une formule sommeprod), avant qu'elle ne progresse jusqu'à la ligne 1000.

Voici un exemple explicatif.

Bonne journée.

 

[Rouge]

Bonjour,

Ceci:

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 Sub

Cdlt

 

[OlivGM]

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

 

[Rouge]

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.

 

[Rouge]

Suite à la remarque de OlivGM, voici une autre version qui ne renvois pas de doublons.

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]

Bonjour.
Ma version :

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 Sub

Avant de tenter l'exécution, glissez/déplacez le module de classe ListeAléat depuis le projet VBA du classeur joint.

 

[ALEA()]

Bonjour,

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]

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.