Macro pour touche F9 (ALEA)

[JJ1]

Bonsoir le Forum,

Dans mon fichier, je souhaiterais un code VBA qui agit 1000 fois sur la touche F9 pour produire aléatoirement 1000 fois 12 nombres et les conserver à partir de la colonne AA.
Pouvez-vous m'y aider?
merci
Bonne soirée

 

[Tibo]

Re : Macro pour touche F9 (ALEA)

Bonsoir,

Le plus simple (et sans doute plus rapide) serait peut-être de copier tes formules sur AA1:AL1, de les recopier 1000 fois vers le bas, suivi d'un Copier - Collage spécial - Valeur.

@+

 

[JJ1]

Re : Macro pour touche F9 (ALEA)

Bonsoir Tibo, j'y ai pensé mais je préférais une macro car le tableau est très "encombré" à l'endroit de l'alea (suivi de petite.valeur pour les classer) donc je pensais à une macro?
Je lance le code et je laisse tourner (je ne suis pas pressé!)
On verra si c'est possible sinon je ferai par copier-coller.
Bonne soirée

 

[JCGL]

Re : Macro pour touche F9 (ALEA)

Bonjour à tous,
Salut JJ,
Salut Tibo,

Peux-tu essayer avec :

Option Explicit

Sub Alea()
    Range("AA1:AL1000").ClearContents
    Range("AA1:AL1000").Formula = "=ALEA.ENTRE.BORNES(1,20)"
    Columns("AA:AL").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("L1").Select
End Sub

Dans un Module

A+ à tous

 

[phlaurent55]

Re : Macro pour touche F9 (ALEA)

Bonjour à tous, JJ1, Tibo, Jean-claude,

ma modeste contribution en pièce jointe

à+
Philippe

 

[JJ1]

Re : Macro pour touche F9 (ALEA)

Bonsoir Tibo, JCGL, PHLaurent, Le forum
Merci à vous.

Je pourrai (peut-être) revenir vers vous pour un ajout dans la macro si nécessaire.

Bonne soirée

 

[JJ1]

Re : Macro pour touche F9 (ALEA)

Re,

Mon intuition était hélas vraie! j'ai mis un bout de code :
Sub Macro1()
Dim i As Integer
For i = 1 To 10 'ce sera 1000
Calculate
Range("M1:X1").Select
Selection.Copy
Range("AA" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select
Next i
End Sub

Ce code copie simplement les résultats de l'aléa (créé par UNE FORMULE et non la macro) mais ....il y a des doublons (voire plus, dans les lignes copiées (AA1:AL1 par exemple)

Comment faire pour que la macro, soit n'écrive pas et passe au next i si doublon, ou n'inscrive que les nombres différents (c'est à dire par forcément 12 nombres par ligne)?

Si vous avez une solution?
merci beaucoup.
Bonne soirée

 

[tototiti2008]

Re : Macro pour touche F9 (ALEA)

Bonsoir à tous,

Donc, si j'ai bien compris, tu veux 12000 nombres aléatoires différents ?

 

[tototiti2008]

Re : Macro pour touche F9 (ALEA)

Re,

un essai :

Sub test()
k = 0
    For i = 1 To 12
        For j = 1 To 1000
            If k = 0 Then Randomize
            Cells(j, i + 5).Value = Rnd
            k = k + 1
            If k > 255 Then k = 0
        Next j
    Next i
End Sub

 

[pierrejean]

Re : Macro pour touche F9 (ALEA)

Bonjour a tous

De retour apres un episode orageux qui m'a tenu eloigné d'XLD

Un essai
Normalement les 12 valeurs de chaque ligne ne doivent presenter aucun doublon, et aucune des 1000 lignes ne devrait avoir son double exact

 

[JJ1]

Re : Macro pour touche F9 (ALEA)

Re bonsoir à tous,

Merci pour vos codes.
Toutefois je précise que l'aléa est déjà fait par une formule dans le fichier.
Donc la macro fait 1000 fois un "calculate" , copie les résultats et c'est à ce niveau que se pose le problème des doublons (et pas en amont)
merci
Bonne soirée à vous tous.

 

[phlaurent55]

Re : Macro pour touche F9 (ALEA)

Re,

Toutefois je précise que l'aléa est déjà fait par une formule dans le fichier.

si tu parles de formules contenues dans les cellules M1:X1, elles ne sont plus nécessaires (d'ailleurs, elles posent problème sur mon PC)
Le fichier réalisé par PierreJean répond exactement à la demande à moins que nous n'ayons rien compris

Toutefois je précise que l'aléa est déjà fait par une formule dans le fichier.
Donc la macro fait 1000 fois un "calculate" , copie les résultats et c'est à ce niveau que se pose le problème des doublons (et pas en amont)

mais pas du tout, c'est bien les formules en M1:X1 (en amont) qui risquent d'amener des doublons qui pourrons s'ils existent être copiés là où tu ne veux pas en avoir




@tototiti:

Donc, si j'ai bien compris, tu veux 12000 nombres aléatoires différents ?

et en plus compris entre 1 et 20 😀😀😀
te tracasse pas tototiti c'est faisable avec des nombre décimaux

à+
Philippe

 

[JJ1]

Re : Macro pour touche F9 (ALEA)

Bonjour,
et merci pour vos réponses.
C'est moi qui doit mal m'expliquer: dans la macro le "Randomize" n'est pas nécessaire car le résultat est obtenu par formule Alea et petite.valeur dans mon fichier donc ma macro (voir mon code ci-dessus) se borne à une boucle de 1000 "calculate" +1000 copies /valeurs vers les colonnes AA1:AL1000.
C'est au niveau de cette copie que la condition doublon interviendrait pur supprimer les numéros en double ou plus (ne copier sur une ligne que les numéros différents par ex même s'il n'y a plus 12 nombres copiés).
ex: supposons qu'alea me donne:
1 2 3 3 4 5 5 5 5 6 7 10
la macro ne copierait que :
1 2 3 4 5 6 7 10
Je ne sais pas si c'est plus clair......

Bon mardi

 

[tototiti2008]

Re : Macro pour touche F9 (ALEA)

Bonjour à tous,

c'est clair mais pourquoi absolument utiliser ces formules, alors qu'en utilisant un Randomize on peut s'affranchir de ton problème de doublons ?
sur mon exemple (et sans doute celui de PierreJean que je n'ai pas pu ouvrir) aucune valeur en double n'est généré sur les 12000 valeurs (même si chez moi elles ne sont pas de 1 à 20), grâce à ce fameux Randomize que tu ne veux pas utiliser...

 

[pierrejean]

Re : Macro pour touche F9 (ALEA)

Re

Voici une nouvelle version

et pour mon ami Tototiti les codes des 2 versions

Sub test()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim coll1 As Collection
Dim coll2 As Collection
Set coll1 = New Collection
Set coll2 = New Collection
While coll1.Count < 1000
While coll2.Count < 12
Randomize
x = Int((20 * Rnd) + 1)
On Error Resume Next
 coll2.Add x, CStr(x)
On Error GoTo 0
Wend
 For n = 1 To coll2.Count
   Z = Z & coll2(n) & ";"
 Next n
   Z = Left(Z, Len(Z) - 1)
On Error Resume Next
  coll1.Add Z, CStr(Z)
On Error GoTo 0
Z = ""
For p = 1 To coll2.Count
  coll2.Remove 1
Next
Wend
For n = 1 To coll1.Count
  For m = LBound(Split(coll1(n), ";")) To UBound(Split(coll1(n), ";"))
     Cells(n, 27 + m) = Split(coll1(n), ";")(m)
  Next m
Next n
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub test2()
Columns("AA:AL").ClearContents
ligne = 1
Dim coll As Collection
Set coll = New Collection
While ligne < 1001
Calculate
For n = 13 To 24
x = Cells(1, n)
 On Error Resume Next
   coll.Add x, CStr(x)
 On Error GoTo 0
Next n
For n = 1 To coll.Count
 Cells(ligne, 26 + n) = coll(n)
Next n
For n = 1 To coll.Count
 coll.Remove 1
Next n
ligne = ligne + 1
Wend
End Sub