Mélanger les nombres sur une seule colonne au lieu de 2

Bonjour

Dans le fichier ci-dessous en colonne A j'ai des nombres ,avec une macro je cherche à les mélanger sur une seule colonne B

comment modifier le code vba

Merci pour votre aide

test.xlsm

Sub tirage()

Cancel = True
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
iNb = Fix((iRow - 1) / 2)
iMod = (iRow - 1) Mod 4
tTab = Range("A2:A" & iRow).Value
'[D2:K18].ClearContents
iCol = 1
For x = 2 To iRow
    iTRow = 1
    iCol = iCol + 1
    iNum = iNum + 1
    For y = x To x + (iNb - 1) + IIf(iNum <= iMod, 1, 0)
        iTRow = iTRow + 1
        Do
            iRnd = Int((iRow - 1) * Rnd + 1)
        Loop Until CInt(tTab(iRnd, 1)) > 0
        Cells(iTRow, iCol) = tTab(iRnd, 1)
        tTab(iRnd, 1) = 0
    Next
    x = y - 1
Next
End Sub

Salut Joco,

on dirait un de mes codes mais sorti de son contexte.
Par curiosité, il vient de quel fichier. Complètement oublié!
Un double-clic sur la feuille démarre la macro

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, iRow%, iTRow%
'
Cancel = True
'
iRow = Range("A" & Rows.Count).End(xlUp).Row - 1
tTab = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
Columns(2).ClearContents
iTRow = 1
For x = 1 To UBound(tTab, 1)
    Randomize
    Do
        iRnd = Int((iRow * Rnd) + 1)
    Loop Until CInt(tTab(iRnd, 1)) > 0
    iTRow = iTRow + 1
    Cells(iTRow, 2) = tTab(iRnd, 1)
    tTab(iRnd, 1) = 0
Next
'
End Sub

**Fichier avec une grosse erreur = retiré!**

A+

Bonsoir,

Si j’ai bien compris, il faut mélanger tous les nombres de la colonne A vers la colonne B.

Alors essayez ce code :

Sub tirage()
Dim t, i&, n&, aux
   t = Range(Cells(2, "a"), Cells(Rows.Count, "a").End(xlUp))
   Randomize
   For i = 1 To UBound(t)
      n = 1 + Int(Rnd * UBound(t))
      aux = t(i, 1): t(i, 1) = t(n, 1): t(n, 1) = aux
   Next i
   Range("b2:b" & Rows.Count).ClearContents
   Range("b2").Resize(UBound(t), 1) = t
End Sub

Salut Mafraise,

joli! Beaux raccourcis auxquels je n'avais pas pensé!
Mais, je n'ai quand même pas compris ceci !

aux = t(i, 1): t(i, 1) = t(n, 1): t(n, 1) = aux

Du coup, comme j'avais fait une bêtise dans mon code (une maniaquerie qui a foutu tout en l'air ), je corrige en m'inspirant de tes raccourcis!

tTab = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
Columns(2).ClearContents
For x = 1 To UBound(tTab, 1)
    Randomize
    Do
        iRnd = Int((UBound(tTab, 1) * Rnd) + 1)
    Loop Until CInt(tTab(iRnd, 1)) > 0
    Cells(x + 1, 2) = tTab(iRnd, 1)
    tTab(iRnd, 1) = 0
Next

A+

OK, j'ai compris le principe... mais pas encore pourquoi ça fonctionne à tous les coups!

...va encore me prendre la tête, ce truc!

Bonsoir curulis57

Mais, je n'ai quand même pas compris ceci !

aux = t(i, 1): t(i, 1) = t(n, 1): t(n, 1) = aux

Le principe de l'algorithme est une boucle d'indice i pour parcourir le tableau source t. Pour chaque élément du tableau :

• on calcule un nombre au hasard n
• on procède à l'échange entre les deux éléments i et n de t

Classiquement pour échanger deux éléments, il en faut un troisième (aux) :

1. On affecte t(i,1) à aux.
2. On affecte t(n,1) à t(i,1) (à ce niveau on a perdu la valeur initiale de t(i,1) puisque maintenant t(i,1) vaut t(n,1) mais on l'avait sauvegardée dans aux).
3. On affecte aux à t(n,1) [aux est l'ancienne valeur de t(i,1)].
4. L'échange des valeurs a donc été réalisé.

.

Cette manière de faire un mélange permet de mélanger n'importe quoi et pas seulement des nombres et elle est rapide.

Oui, j'avais compris le principe mais ce que je comprends pas, c'est qu'il y a une boucle 'i' fixe.
Comment peut-on être certain que le même nombre ne sortira pas 20 X de suite?
Je m'y replonge...

OK, j'ai capté le truc!
Je note dans mon petit livre!

Merci pour cet algo bien astucieux, mafraise!

A+

Re,

Comment peut-on être certain que le même nombre ne sortira pas 20 X de suite?

Quand on fait n fois un tirage aléatoire de nombre entre 1 et 25 (25 pour l'exemple), rien n'empêche de tirer le nombre 1 à chacun des n tirages.

Mais plus le nombre n de tirage augmente, plus la probabilité de n'avoir tiré que des 1 diminue.

• Premier tirage -> tirer un 1 : la probabilité vaut 0,25
• Tirages 1 à 2 = > tirer un 1 : la probabilité vaut 0,25 * 0,25 soit 0,0016
• Tirages 1 à 3 = > tirer un 1 : la probabilité vaut 0,25 * 0,25 * 0,25 soit 0,000064
• Tirages 1 à 25 = > tirer un 1 : la probabilité vaut 0,25 * 0,25 * 0,25 ... 0,25 (25 fois) soit un ordre de grandeur de 0,00000000000000000000000000000000001

Donc plus le nombre de tirages augmente, plus la probabilité de tirer toujours le même nombre donné tend vers zéro.

Et quand bien même cela se produirait, cela ne serait qu'un des tirages aléatoires possibles et donc ce serait un tirage tout à fait légitime.

Bonjour mafraise , curulis57

Merci pour vos réponses, j'ai ce qu'il me fallait.

@curulis il est possible que tu sois à l'origine du code que j'ai utilisé ,je ne sais plus sur quel fichier.

@mafraise dans le code que tu me donnes est il possible d'ajouter une colonne:

je m'explique actuellement la colonne A est bien mélangée en colonne B, est ce possible d'avoir un autre tirage

dans la colonne C tout en gardant le tirage colonne B

Crdlt

Re bonjour

C'est bon j'ai trouvé, tout simplement en recopiant une partie du code et en modifiant les données de colonne

Bon 14 juillet

Crdlt

Salut Joco, Mafraise,

Toujours un double-clic pour obtenir un nouveau tirage et un clic droit pour effacer tous les tirages affichés.

Dim tTab, iCol%, iRnd%
'
Cancel = True
'
tTab = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
iCol = Range("ZZ1").End(xlToLeft).Column + 1
Columns(iCol).ClearContents
For x = 1 To UBound(tTab, 1)
    Randomize
    Do
        iRnd = Int((UBound(tTab, 1) * Rnd) + 1)
    Loop Until CInt(tTab(iRnd, 1)) > 0
    Cells(x, iCol) = tTab(iRnd, 1)
    tTab(iRnd, 1) = 0
Next
Columns(iCol).AutoFit

A+

Salut curulis57

J'ai mis ton fichier dans ma réserve très intéressant

Crdlt

Avec plaisir!

Bon dimanche!
A+