Microsoft 365 Problème de distribution et de permutations.

Gégé-45550

XLDnaute Accro
Bonjour amis Excel'lents !
Tout est dans le titre et le fichier ci-joint.
Merci d'avance de vos brillants éclairages (je sais, cette phrase ouvre la porte à toutes les blagues du genre "illuminations à l'approche de Noël", "on n'est pas des illuminés", "je n'ai pas la lumière à tous les étages" ... ne vous privez surtout pas !)
Amicalement,
 

Pièces jointes

  • Test.xlsx
    13 KB · Affichages: 10

job75

XLDnaute Barbatruc
En utilisant les Application.Calculation et Calculate on réduit de 40% la durée des calculs :
VB:
Sub Tirages()
Dim t, ntirages&, d As Object, tablo, i&, x$, y$, z$, n&, c As Range
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'mode de calcul manuel
'---liste des arrangements---
Range("C2:F" & Rows.Count).ClearContents 'RAZ
Set d = CreateObject("Scripting.Dictionary")
tablo = [A2:A144]
For i = 1 To 143
    x = Left(tablo(i, 1), 1)
    y = Mid(tablo(i, 1), 2, 1)
    z = Right(tablo(i, 1), 1)
    d(x & " " & y & " " & z) = ""
    d(x & " " & z & " " & y) = ""
    d(y & " " & x & " " & z) = ""
    d(y & " " & z & " " & x) = ""
    d(z & " " & x & " " & y) = ""
    d(z & " " & y & " " & x) = ""
Next
[D2].Resize(d.Count) = Application.Transpose(d.Keys)
[D2].Resize(d.Count).TextToColumns [D2], xlDelimited, Space:=True 'commande Convertir
[C2].Resize(d.Count) = "=RAND()"
'---tris aléatoires---
[M2:O144].ClearContents 'RAZ
With [C1].CurrentRegion.Resize(, 4)
    For n = 1 To ntirages
        If n Mod 100 = 0 Then Application.StatusBar = Format(n, "#,##0") & " tirages" 'pour faire patienter...
        .Sort .Columns(1), Header:=xlYes
        .Columns(1).Calculate 'recalcul de la colonne
        For Each c In Range("I2:K13")
            c.Calculate 'recalcule la cellule
            If c > 14 Then GoTo 1
        Next c
        [M2:O144] = [D2:F144].Value
        Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
        Application.ScreenUpdating = True
        MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
        Exit Sub
1   Next n
End With
Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
 

Pièces jointes

  • Arrangements(3).xlsm
    26.2 KB · Affichages: 4

Gégé-45550

XLDnaute Accro
En utilisant les Application.Calculation et Calculate on réduit de 40% la durée des calculs :
VB:
Sub Tirages()
Dim t, ntirages&, d As Object, tablo, i&, x$, y$, z$, n&, c As Range
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'mode de calcul manuel
'---liste des arrangements---
Range("C2:F" & Rows.Count).ClearContents 'RAZ
Set d = CreateObject("Scripting.Dictionary")
tablo = [A2:A144]
For i = 1 To 143
    x = Left(tablo(i, 1), 1)
    y = Mid(tablo(i, 1), 2, 1)
    z = Right(tablo(i, 1), 1)
    d(x & " " & y & " " & z) = ""
    d(x & " " & z & " " & y) = ""
    d(y & " " & x & " " & z) = ""
    d(y & " " & z & " " & x) = ""
    d(z & " " & x & " " & y) = ""
    d(z & " " & y & " " & x) = ""
Next
[D2].Resize(d.Count) = Application.Transpose(d.Keys)
[D2].Resize(d.Count).TextToColumns [D2], xlDelimited, Space:=True 'commande Convertir
[C2].Resize(d.Count) = "=RAND()"
'---tris aléatoires---
[M2:O144].ClearContents 'RAZ
With [C1].CurrentRegion.Resize(, 4)
    For n = 1 To ntirages
        If n Mod 100 = 0 Then Application.StatusBar = Format(n, "#,##0") & " tirages" 'pour faire patienter...
        .Sort .Columns(1), Header:=xlYes
        .Columns(1).Calculate 'recalcul de la colonne
        For Each c In Range("I2:K13")
            c.Calculate 'recalcule la cellule
            If c > 14 Then GoTo 1
        Next c
        [M2:O144] = [D2:F144].Value
        Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
        Application.ScreenUpdating = True
        MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
        Exit Sub
1   Next n
End With
Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
Bonsoir,
J'ai du m'absenter et me voilà de retour.
J'ai aussi testé la V3 et 100 000 tirages (moins de 2 minutes) et pas de solution.
Un vrai casse-tête n'est-ce pas ?
À croire que ça irait presque mieux "à la main".
Merci pour tous ces efforts, moi ça commence à me prendre la tête.
Je crois que je vais mettre cette question de côté un moment et y revenir plus tard.
Merci encore
 

Gégé-45550

XLDnaute Accro
En utilisant les Application.Calculation et Calculate on réduit de 40% la durée des calculs :
VB:
Sub Tirages()
Dim t, ntirages&, d As Object, tablo, i&, x$, y$, z$, n&, c As Range
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'mode de calcul manuel
'---liste des arrangements---
Range("C2:F" & Rows.Count).ClearContents 'RAZ
Set d = CreateObject("Scripting.Dictionary")
tablo = [A2:A144]
For i = 1 To 143
    x = Left(tablo(i, 1), 1)
    y = Mid(tablo(i, 1), 2, 1)
    z = Right(tablo(i, 1), 1)
    d(x & " " & y & " " & z) = ""
    d(x & " " & z & " " & y) = ""
    d(y & " " & x & " " & z) = ""
    d(y & " " & z & " " & x) = ""
    d(z & " " & x & " " & y) = ""
    d(z & " " & y & " " & x) = ""
Next
[D2].Resize(d.Count) = Application.Transpose(d.Keys)
[D2].Resize(d.Count).TextToColumns [D2], xlDelimited, Space:=True 'commande Convertir
[C2].Resize(d.Count) = "=RAND()"
'---tris aléatoires---
[M2:O144].ClearContents 'RAZ
With [C1].CurrentRegion.Resize(, 4)
    For n = 1 To ntirages
        If n Mod 100 = 0 Then Application.StatusBar = Format(n, "#,##0") & " tirages" 'pour faire patienter...
        .Sort .Columns(1), Header:=xlYes
        .Columns(1).Calculate 'recalcul de la colonne
        For Each c In Range("I2:K13")
            c.Calculate 'recalcule la cellule
            If c > 14 Then GoTo 1
        Next c
        [M2:O144] = [D2:F144].Value
        Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
        Application.ScreenUpdating = True
        MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
        Exit Sub
1   Next n
End With
Application.Calculation = xlCalculationAutomatic 'mode de calcul automatique
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
Testé 1 000 000 (1 million) de tirages => 15' => échec.
Je lance 10 000 000.
 

Gégé-45550

XLDnaute Accro
Bonsoir,
J'ai du m'absenter et me voilà de retour.
J'ai aussi testé la V3 et 100 000 tirages (moins de 2 minutes) et pas de solution.
Un vrai casse-tête n'est-ce pas ?
À croire que ça irait presque mieux "à la main".
Merci pour tous ces efforts, moi ça commence à me prendre la tête.
Je crois que je vais mettre cette question de côté un moment et y revenir plus tard.
Merci encore
Hello TooFatBoy,
Alors ça y est, l'ordi est réparé ?
 

TooFatBoy

XLDnaute Barbatruc
Non. Rien à faire, il ne repart pas. 😭

Un truc de fou :
- PC éteint, interrupteur de l'alimentation sur "1", j'ai du jus sur le port PS/2,
- PC allumé, interrupteur de l'alimentation sur "1" (évidemment), je n'ai plus de jus sur le port PS/2 !

Je vais être obligé de changer de PC après seulement 14 ans de bons et loyaux services... 😭😭😭



Et toi, fini de tourner cet algo sur 10 000 000 ?
Si pas de tirage répondant aux critères, tu passes à 100 000 000 ??? 🤔
 

Gégé-45550

XLDnaute Accro
Non. Rien à faire, il ne repart pas. 😭

Un truc de fou :
- PC éteint, interrupteur de l'alimentation sur "1", j'ai du jus sur le port PS/2,
- PC allumé, interrupteur de l'alimentation sur "1" (évidemment), je n'ai plus de jus sur le port PS/2 !

Je vais être obligé de changer de PC après seulement 14 ans de bons et loyaux services... 😭😭😭



Et toi, fini de tourner cet algo sur 10 000 000 ?
Si pas de tirage répondant aux critères, tu passes à 100 000 000 ??? 🤔
 

Gégé-45550

XLDnaute Accro
C'est vrai que 14 ans pour un PC, ce n'est pas comme si le matériel évoluait en moyenne tous les 6 mois 😂
Le port PS/2, ça a bien 14 ans c'est vrai ;).
Un bon vieux clavier (ou souris) en USB filaire ne ferait pas l'affaire ?
De mon côté, j'en suis à 4,5M mais je ne me fais pas trop d'illusions ... je veux juste être sûr.
Cette question, c'est un truc de malade, ça paraît simple et ... que dalle. Et encore, j'ai posé la question simple, en réalité, la limite est variable suivant les lettres, 14 étant la plus grande des valeurs (la plus faible est 10).
Bien cordialement,
 

Gégé-45550

XLDnaute Accro
Bonjour Gégé-45550, le forum,

Juste pour signaler que votre liste imposée en colonne A ne paraît pas normale.

Elle contient en effet 83 valeurs uniques et 60 doublons.

A+
Bonjour job75, la liste
Hier j'étais assez occupé et sans doute confus.
Je pense que j'ai mal posé le problème en voulant le simplifier et je m'en excuse.
L'énoncé du problème est le suivant :
143 joueurs doivent réaliser 3 épreuves parmi 12, listées de A à L.
Ces épreuves leur sont imposées (c'est la liste des 143 triplets).
Pour réaliser ces épreuves, il existe 12 lieux dont les places sont limitées (14 places pour l'épreuve A, 12 places pour la B, 14 pour la C, 10 pour la D, puis succession de 14, 12, 14, 12 etc.
Bien entendu, ils ne peuvent pas être en 3 lieux en même temps, il est donc créé 3 sessions par lieu, avec les mêmes limites de places.
Le but du jeu est de les répartir dans les lieux et les sessions pour que tous soient servis selon les contraintes imposées.
Ce qui implique qu'il n'est absolument pas nécessaire de retrouver tous les éléments d'un même triplet sur la même ligne.
Mais ça reste un vrai casse-tête.
J 'aurai du commencer par là, toutes mes plus plates excuses.:mad::rolleyes::oops:o_O
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonjour
@TooFatBoy
  1. débranche ton/tes disk dur
  2. ne laisse qu'une seule barrette de mémoire
  3. essaie de démarrer
  4. normalement c'est l’écran noir avec l'avertissement no diskdrive blablabla
  5. éteint et redémarre mais avec les touches pour aller dans le bios
  6. réinitialiser tout par défaut
  7. ci ca marche alors change la pile c'est elle qui t'a foutu le bordel et ton eprom c'est trouvé sous alimenté
  8. si tu a les cdrom de ta carte mere c'est encore mieux réinstalle les driver des bus
 

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 724
Membres
110 552
dernier inscrit
jasson