placement de chiffres

P

phil59110

XLDnaute Occasionnel
Bonjour a tous et a toutes!!!!!
et j'espére que vous avez passer de bonne vacances!!!
voila j'ai un petit souci avec un tableau de chifres mais comme milles explications ne vaux pas un exemple je vous joint un petit fichier
si vous voulez bien y jeter un coup d'oeil
je vous en Remerci beaucoup!!
 

Pièces jointes

  • Classeur1.xls
    16 KB · Affichages: 210
  • Classeur1.xls
    16 KB · Affichages: 188
  • Classeur1.xls
    16 KB · Affichages: 194
Trier par date Trier par votes
P

phil59110

XLDnaute Occasionnel
Re : placement de chiffres

ROGER2327 à dit:
Re-bonjour à tous
Un peu tard peut-être, une procédure qui garantit l'absence de doublon sur chaque ligne, mais ne garantit pas l'utilisation de toutes les données :
Code: 
[COLOR="DarkSlateGray"]Sub ZERO_DOUBLON_PAR_LIGNE()
Dim oDat(), sDat(), i As Long, j As Long, k As Long
   oDat = Range("C7:C20").Value
   ReDim sDat(1 To 5, 1 To 4)
   Randomize
   For i = 1 To 5
      For j = 1 To 4
         k = j + Int((15 - j) * Rnd)
         sDat(i, j) = oDat(k, 1): oDat(k, 1) = oDat(j, 1): oDat(j, 1) = sDat(i, j)
      Next j
   Next i
   Range("M3:P7").Value = sDat
End Sub[/COLOR]
Bonne soirée !
ROGER2327
Cliquez pour agrandir...

oui il fonctionne bien aussi et simple pour faire des modifs!
dommage comme tu dit qu'il prend pas toutes les données

merci beaucoup!!!
 
Vote positif 0 Vote négatif
S

SubEndSub

XLDnaute Occasionnel
Re : placement de chiffres

Bonsoir chez vous

De retour dans les aléas

phil59110:

Dans ton premier message dans ta pièce jointe, tu écris :

Bonjour a tous et a toutes!!!

voila j'ai deux tableaux qui se présentent comme ceci
et je voudrais bien sure si c'est possible que les chiffres
en colonne C7 C20 vienne ce placé aléatoirement dans
le tableau M3 P7 dans n'importe quel ordre
le seule truc c'est qu'il ne faut pas qu'il y a de doublons par ligne
Cliquez pour agrandir...

Or comment mettre les 13 cellules de C7:C20 dans la plage M3:p7 ( 16 cellules ) :confused:

Il y aura des cellules vides non ?

Bravo à tous les autres pour leurs solutions.
 
Vote positif 0 Vote négatif
P

phil59110

XLDnaute Occasionnel
Re : placement de chiffres

SubEndSub à dit:
Bonsoir chez vous

De retour dans les aléas

phil59110:

Dans ton premier message dans ta pièce jointe, tu écris :



Or comment mettre les 13 cellules de C7:C20 dans la plage M3:p7 ( 16 cellules ) :confused:

Il y aura des cellules vides non ?

Bravo à tous les autres pour leurs solutions.
Cliquez pour agrandir...

oui tu as raison!mais ce n'est pas grave parce comme PierreJean la remarquer
on peut reprendre les méme données tant qu'il n'y a pas de doublons sur une mémé ligne!!

merci SubEndSub!!!
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : placement de chiffres

Re...
phil59110 à dit:
(...)
dommage comme tu dit qu'il prend pas toutes les données
(...)
Cliquez pour agrandir...
On va arranger ça.
Code: 
[COLOR="DarkSlateGray"]Sub ZERO_DOUBLON_PAR_LIGNE()
Dim oDat(), sDat(), tst() As Long, i As Long, j As Long, k As Long
   oDat = Range("C7:C20").Value
   ReDim sDat(1 To 5, 1 To 4)
   Randomize
   Do
      ReDim tst(1 To 18)
      For i = 1 To 5
         For j = 1 To 4
            k = j + Int((15 - j) * Rnd)
            sDat(i, j) = oDat(k, 1): oDat(k, 1) = oDat(j, 1): oDat(j, 1) = sDat(i, j)
            tst(sDat(i, j)) = 1
         Next j
      Next i
      j = 0
      For i = 1 To 18
         j = j + tst(i)
      Next i
   Loop Until j = 14
   Range("M3:P7").Value = sDat
End Sub[/COLOR]
ROGER2327
 
Vote positif 0 Vote négatif
P

phil59110

XLDnaute Occasionnel
Re : placement de chiffres

ROGER2327 à dit:
Re...
On va arranger ça.
Code: 
[COLOR="DarkSlateGray"]Sub ZERO_DOUBLON_PAR_LIGNE()
Dim oDat(), sDat(), tst() As Long, i As Long, j As Long, k As Long
   oDat = Range("C7:C20").Value
   ReDim sDat(1 To 5, 1 To 4)
   Randomize
   Do
      ReDim tst(1 To 18)
      For i = 1 To 5
         For j = 1 To 4
            k = j + Int((15 - j) * Rnd)
            sDat(i, j) = oDat(k, 1): oDat(k, 1) = oDat(j, 1): oDat(j, 1) = sDat(i, j)
            tst(sDat(i, j)) = 1
         Next j
      Next i
      j = 0
      For i = 1 To 18
         j = j + tst(i)
      Next i
   Loop Until j = 14
   Range("M3:P7").Value = sDat
End Sub[/COLOR]
ROGER2327
Cliquez pour agrandir...

ok je teste ça et je dit quoi demain
merci beaucoup ROGER2327 et bonne nuit a toi!!!!
 
Vote positif 0 Vote négatif
S

SubEndSub

XLDnaute Occasionnel
Re : placement de chiffres

Le bonsoir de nouveau à tous

Voici une version en VBA

J'ai utilisé une procédure écrite par F. Sigonneau. (pour la partie tri aléatoire)
 

Pièces jointes

  • pj739049-post21.zip
    12.6 KB · Affichages: 54
Dernière édition:
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : placement de chiffres

Bonjour à tous
Voici deux propositions :
  1. Code: 
    [COLOR="DarkSlateGray"]Sub ZERO_DOUBLON_PAR_LIGNE_10()
Dim oDat(), sDat(), n As Long, i As Long, j As Long, k As Long, tf As Boolean, s
   oDat = Range("C7:C20").Value
   With Range("M3:P7")
      sDat = .Value
      n = UBound(oDat, 1)
      Randomize
      Do
         For i = 1 To UBound(sDat, 1)
            For j = 1 To UBound(sDat, 2)
               k = j + Int((1 + n - j) * Rnd)
               sDat(i, j) = oDat(k, 1): oDat(k, 1) = oDat(j, 1): oDat(j, 1) = sDat(i, j)
            Next j
         Next i
         For i = 1 To n
            tf = False
            s = oDat(i, 1)
            For j = 1 To UBound(sDat, 1)
               For k = 1 To UBound(sDat, 2)
                  tf = tf Or (s = sDat(j, k))
               Next k
            Next j
            If Not tf Then Exit For
         Next i
      Loop Until tf
      .Value = sDat
   End With
End Sub[/COLOR]
    qui n'est autre que ma proposition d'hier soir remaniée pour être plus commode à adapter.
    Le tirage pour chaque ligne est fait sur l'ensemble des données.
    Chaque donnée figure dans au moins un ligne. (Autrement dit : toutes les données sont utilisées au moins une fois.)
    _
  2. Code: 
    [COLOR="DarkSlateGray"]Sub ZERO_DOUBLON_PAR_LIGNE_1()
Dim oDat(), sDat(), n As Long, i As Long, j As Long, k As Long, t As Integer, s As Integer
   oDat = Range("C7:C20").Value
   With Range("M3:P7")
      sDat = .Value
      n = 1 + UBound(oDat, 1)
      Randomize
      For i = 1 To UBound(sDat, 1)
         s = 0
         For j = 1 To UBound(sDat, 2)
            If t = n - 1 Then t = 1: s = j Else t = t + 1
            k = 1 + s + Int((n - t - s) * Rnd)
            sDat(i, j) = oDat(k, 1): oDat(k, 1) = oDat(n - t, 1): oDat(n - t, 1) = sDat(i, j)
         Next j
      Next i
      .Value = sDat
   End With
End Sub[/COLOR]
    plus court et généralement beaucoup plus rapide.
    Mais le tirage est nettement moins aléatoire car une donnée n'est réutilisée que lorsque toutes les autres ont été utilisées.
_
N'ayant pas d'information sur le but que vous visez, je n'ai aucune idée de ce qui est préférable. A vous de voir...
Dans le classeur joint, vous trouverez la mise en application sur une zone plus étendue que celle de l'exemple initiale. Vous verrez mieux la différence entre les solutions.​
ROGER2327
 

Pièces jointes

  • phil59110_Classeur1-3.zip
    17.2 KB · Affichages: 61
Vote positif 0 Vote négatif
HIJACK

HIJACK

XLDnaute Junior
Re : placement de chiffres

Salut tout le monde,
J'arrive apres la bagarre, mais j'avais envisagé une autre approche.
Bon je la publie à tout hasard, maintenant que c'est fait.....
Brut de fonderie, quand même, je me suis arrêter quand j'ai vu que la discution semblait close! Je suis sous 2007, et il me semble avoir compris que lui seul acceptait le tri sous plus de 3 conditions, il faudra donc changer ça. Pour se rapprocher le plus de l'aléatoire, le jeu consistait à creer une table de grande dimensions sans doublons. Ca vaut ce que, cela vaut, je voulais mettre ma petite brique :mad:

Code: 
Sub Macro2()
    Columns("U:X").ClearContents
    
    Range("M3:P7").ClearContents
 'Application.ScreenUpdating = False
    
For i = 1 To 1000
For j = 21 To 24
RECOM:

Randomize


ALEA = CInt(Int((18 * Rnd()) + 1))

If ALEA = 5 Or ALEA = 10 Or ALEA = 13 Or ALEA = 17 Then GoTo RECOM

Cells(i, j) = ALEA


Next j

For k = 22 To 24
prems = Cells(i, k - 1)
doublon = Application.Match(prems, Range(Cells(i, k), Cells(i, 24)), 0)
'doublon = Application.Match(prems, Range("U" & i & ":X" & i), 0)
If IsError(doublon) = False Then
i = i - 1 'Range(Cells(i, k), Cells(i, 24)).Delete
GoTo saut
End If

Next k

    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "U" & i & ":X" & i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("U" & i & ":X" & i)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

saut:

Next i



    Columns("U:X").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("U1:U1000" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("V1:V1000" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("W1:W1000" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("X1:X1000" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("U1:X1000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With





borns = 1
borni = 1
cgt:
Do While Cells(borns, 24) <> ""
continu:
If Cells(borni, 23) = Cells(borns + 1, 23) Then
    borni = borni + 1
    GoTo continu

Else
    For elim = borns To borni - 2
        If Cells(elim, 24) = Cells(elim + 1, 24) Then
        Range(Cells(elim + 1, 21), Cells(elim + 1, 24)).Delete Shift:=xlUp
        elim = elim - 1
        borni = borni - 1
        End If
    Next elim
End If
            borns = borni + 2
            borni = borns
            GoTo cgt
Loop

End Sub
Sub TIRAGE()
 Range("M3:P7").ClearContents
fin = Range("U1000").End(xlUp).Row
For parach = 3 To 7

'Randomize
ALEB = CInt(Int((fin * Rnd()) + 1))
Range(Cells(ALEB, 21), Cells(ALEB, 24)).Copy


Range(Cells(parach, 13), Cells(parach, 16)).PasteSpecial
Next parach
'Application.ScreenUpdating = True

End Sub
 
Vote positif 0 Vote négatif
CISCO

CISCO

XLDnaute Barbatruc
Re : placement de chiffres

Bonsoir à tous

Une possibilité (un peu longue il est vrai, sans macro, sans colonne ou ligne intermédiaire, mais avec des calculs matriciels) de tirer au hasard 8 nombres dans une liste de 18, sans doublon. A vérifier...

@ plus
 

Pièces jointes

  • Tableau alea bis.xls
    36 KB · Affichages: 120
Dernière édition:
Vote positif 0 Vote négatif
CISCO

CISCO

XLDnaute Barbatruc
Re : placement de chiffres

Bonjour à tous

Merci Roger2327

J'aurai bien aimé trouver une formule plus simple, avec un seul SI(...), du style SI($N3:p3=C$3:C$20....) mais pour le moment, je n'y arrive pas...

Ceci dit, ci-dessous, un fichier répondant plus précisément à la demande de Phil59110 (4 nombres au hasard parmi 14, sans doublon), toujours avec la même méthode.

@ plus
 

Pièces jointes

  • Tableau alea ter.xls
    36.5 KB · Affichages: 114
Vote positif 0 Vote négatif
CISCO

CISCO

XLDnaute Barbatruc
Re : placement de chiffres

Bonjour à tous

Une variante du fichier tableau alea bis, un "petit peu" plus simple, qui permet le copier-coller vers la droite à partir de la cellule J2.

@ plus
 

Pièces jointes

  • Tableau alea bis bis.xls
    28 KB · Affichages: 120
Vote positif 0 Vote négatif
CISCO

CISCO

XLDnaute Barbatruc
Re : placement de chiffres

Bonjour à tous

Une variante, acceptant aussi bien des nombres que du texte dans la plage source (C3:C20 dans l'exemple).

On peut copier la formule vers la droite et vers le bas à partir de la cellule J3.

@ plus

P.S : le 27/02/2012 Modif de la formule dans le fichier (Certains 0 qui n'avaient pas lieu d'être là apparaissaient dans le tableau)
Ancienne formule en I3
Code: 
INDEX($C$1:$C$20;PETITE.VALEUR((ESTNA(EQUIV($C$3:$C$20;$H3:H3;0)))*LIGNE($C$3:$C$20);ENT(ALEA()*(NBVAL($C$3:$C$20)-COLONNES($G1:G1))+COLONNES($G1:G1)-1)))
nouvelle formule
Code: 
INDEX($C$1:$C$20;PETITE.VALEUR((ESTNA(EQUIV($C$3:$C$20;$H3:H3;0)))*LIGNE($C$3:$C$20);ENT(ALEA()*(NBVAL($C$3:$C$20)-COLONNES($G1:G1)+1)+COLONNES($G1:G1))))
 

Pièces jointes

  • Tableau alea bis bis bis bis.xls
    41 KB · Affichages: 173
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2021 Exercice de TCD compliqué pour moi
Réponses
8
Affichages
343
Mapat
Mapat
yojema
  • Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
199
Dranreb
Dranreb
P
  • Question
XL 2021 macro interruption erreur
Réponses
7
Affichages
272
Dranreb
Dranreb
Electron24
  • Résolu(e)
Microsoft 365 Recherche avec plusieurs critères
Réponses
2
Affichages
41
Electron24
Electron24
P
  • Question
Microsoft 365 Filtre listview comboBox en cascades avec tableau structuré
5 6 7
Réponses
103
Affichages
3 K
Dranreb
Dranreb
Mathos
  • Résolu(e)
XL 2021 (Résolu) Aide vrai/faux dans plusieurs colonnes de cases à cocher
2
Réponses
27
Affichages
567
Dranreb
Dranreb
N
  • Question
Microsoft 365 couleur de cellule en fonction de date echeance
Réponses
2
Affichages
352
natadom
N
D
  • Question
Microsoft 365 Fermeture Excel avec son instance applicative
2
Réponses
26
Affichages
840
Dudu2
Dudu2
C
  • Résolu(e)
XL 2021 Supprimer des lignes lorsque, dans une colonne, une certaine valeur est présente
Réponses
14
Affichages
485
Constantin
C
C
  • Résolu(e)
XL 2021 Listes déroulantes en cascade
Réponses
8
Affichages
248
Constantin
C

Membres actuellement en ligne

11 membres et 87 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 489
Messages
2 088 851
Membres
103 974
dernier inscrit
chmikha