repartition aleatoir sans dedeoublon

[Al_bahith]

Bonjour a tous,



J'aurais besoin d'une macro pour faire la chose suivante:

j'ai une série de nombre qui se trouvent sur une ligne ds une 1er feuille " 2 ; 3 ; 5 ; 9 ; 10 ; 0 ; 11 ; 15 "


je veux les reproduire sur 6 lignes par exemple ds une 2 feuille mais on les repartissant aléatoirement chaque fois afin d'avoir la résulta comme ds la pièce jointe.
j'ai essayer avec la fonction aléa() mais le problème c'est qu'il y a toujours des dédoublons sur la même ligne (le même nombre peut se répéter plus qu'une fois sur la même ligne par-contre il faut absolument qu'il ne soit pas répéter)

cordialement

 

[R@chid]

Re : repartition aleatoir sans dedeoublon

Slt tout le monde.
peut etre t'as oublie la piece jointe

 

[Tibo]

Re : repartition aleatoir sans dedeoublon

Bonjour,

Une piste avec le fichier joint (et sur la base de ce que j'ai compris)

@+

 

[Al_bahith]

Re : repartition aleatoir sans dedeoublon

Slt tout le monde.
peut etre t'as oublie la piece jointe

Slt vs avez raison je viens de poster la pièce

 

[Al_bahith]

Re : repartition aleatoir sans dedeoublon

Bonjour,

Une piste avec le fichier joint (et sur la base de ce que j'ai compris)

@+

merci pour l'exemple ça peu m'aider résoudre le problème partiellement


@++

 

[Efgé]

Re : repartition aleatoir sans dedeoublon

Bonjour Al_bahith, Rachid_0661 , Bonjour Tibo
Une proposition par macro:

Private Sub CommandButton1_Click()
Dim i&, j&, k&, L&, M&, azar&
Dim TabTemp(), T As Variant
Application.ScreenUpdating = False
M = 0
With Sheets("Feuil1")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        ReDim TabTemp(0 To 12)
        For j = 0 To 12
            TabTemp(j) = .Cells(i, j + 1)
        Next j
        M = M + 1
        With Cells(Rows.Count, 2).End(xlUp)
            .Offset(1, -1).Value = M
            .Offset(1, 0).Resize(1, 13) = TabTemp
        End With
        For L = 1 To 5
            Randomize
            For k = LBound(TabTemp) + 1 To UBound(TabTemp)
                azar = Int(k * Rnd)
                If azar <> 0 Then
                    T = TabTemp(k)
                    TabTemp(k) = TabTemp(azar)
                    TabTemp(azar) = T
                End If
            Next k
            M = M + 1
            With Cells(Rows.Count, 2).End(xlUp)
                .Offset(1, -1).Value = M
                .Offset(1, 0).Resize(1, 13) = TabTemp
            End With
        Next L
    Next i
End With
Application.ScreenUpdating = True
End Sub

Cordialement

 

[Efgé]

Re : repartition aleatoir sans dedeoublon

Bonjour à tous,
Une version remaniée et beaucoup plus rapide.

Private Sub CommandButton1_Click()
Dim A&, j&, k&, L&, M&, N&, Nbr&
Dim TR(), TD As Variant, T As Variant, LstCol&
Application.ScreenUpdating = False
M = 0: LstCol = 14: Nbr = 6
With Sheets("Feuil1")
    TD = .Range(.Cells(2, 1), .Cells(Rows.Count, LstCol - 1).End(xlUp)).Value
End With
ReDim TR(1 To UBound(TD, 1) * Nbr, 1 To LstCol)
For j = 1 To UBound(TD, 1)
    M = M + 1
    TR(M, 1) = M
    For L = 2 To LstCol
        TR(M, L) = TD(j, L - 1)
    Next L
    For L = 1 To Nbr - 1
        M = M + 1
        TR(M, 1) = M
        For N = 2 To LstCol
            TR(M, N) = TR(M - 1, N)
        Next N
        Randomize
        For k = 3 To LstCol
            Do
                A = Int((k * Rnd) + 1)
            Loop While A < 3
            T = TR(M, k)
            TR(M, k) = TR(M, A)
            TR(M, A) = T
        Next k
    Next L
Next j
With Sheets("Resultat")
    .Range(.Cells(2, 1), .Cells(Rows.Count, LstCol).End(xlUp).Offset(1, 0)).ClearContents
    .Cells(2, 1).Resize(M, LstCol) = TR
End With
Application.ScreenUpdating = True
End Sub

Cordialement