Microsoft 365 Problème de distribution et de permutations.

Gégé-45550

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
Trier par date Trier par votes
Gégé-45550

Gégé-45550

XLDnaute Accro
job75 à dit:
Bonsoir Gégé-45550,

A priori il s'agit des arrangements des 12 lettres A à L pris 3 par 3.

Il y en a 12 x 11 x 10 = 1320, il est facile de les lister.

A+
Cliquez pour agrandir...
Bonsoir job75,
Merci pour cette réponse rapide (peut-être un peu trop) car je ne pense pas qu'après avoir listé tous les arrangements de 3 lettres parmi 12 (ça je sais faire mais je ne vois pas à quoi ça peut me servir), je serai plus avancé pour savoir comment arranger ma liste de 143 éléments de telle manière que la condition "pas plus de 14 lettres identiques à chacune des trois places" soit respectée. De plus, l'algorithme "idéal" doit pouvoir fonctionner quelle que soit cette liste, à condition bien entendu qu'aucune lettre ne soit présente au total plus de 42 fois (3*14).
Cordialement,
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Est-ce qu'on est sûr que ça se calcule ?
On doit pouvoir calculer le nombre de solutions possibles, mais est-il possible d'en sortir au moins une ?

Je vois comment calculer le nombre minimum et maximum théorique d'apparitions possibles aux différents emplacements, pour chacune des 12 lettres, mais à part ça... Je ne vois rien de chez Rien !

​
 
Dernière édition:
Vote positif 0 Vote négatif
Gégé-45550

Gégé-45550

XLDnaute Accro
TooFatBoy à dit:
Bonjour,

Est-ce qu'on est sûr que ça se calcule ?
On doit pouvoir calculer le nombre de solutions possibles, mais est-il possible d'en sortir au moins une ?

Je vois comment calculer le nombre minimum et maximum théorique d'apparitions possibles aux différents emplacements, pour chacune des 12 lettres, mais à part ça... Je ne vois rien de chez Rien !

​
Cliquez pour agrandir...
Bienvenue au club !!!
Mais on y arrive "à la main", ça doit donc pouvoir se calculer (peut-être par itérations ?).
Ah, au fait, il y a au moins une personne qui croit qu'une règle de 111 se vérifie avec une preuve par 1001 ;)🤣
Bien amicalement
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Gégé-45550, TooFatBot, le forum,

Regardez attentivement le fichier joint et cette macro :
VB: 
Sub Tirages()
Dim t, ntirages&, i, j, k, n&, a(1 To 3)
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
'---liste des arrangements---
For i = 65 To 76
    For j = 65 To 76
        If j <> i Then
            For k = 65 To 76
                If k <> i And k <> j Then
                    n = n + 1
                    a(1) = Chr(i)
                    a(2) = Chr(j)
                    a(3) = Chr(k)
                    Cells(n + 1, 2).Resize(, 3) = a
                End If
            Next k
        End If
Next j, i
'---tris aléatoires---
[K2:M144].ClearContents 'RAZ
With [A1].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
        If Application.Max(Range("G2:I13")) <= 14 Then
            [K2:M144] = [B2:D144].Value
            Application.ScreenUpdating = True
            MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
            Exit Sub
        End If
    Next n
End With
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
100 000 tirages prennent du temps, pourtant ce n'est qu'à la 2ème tentative que j'ai obtenu un résultat.

Avec 67 000 tirages en 291 secondes.

A+
 

Pièces jointes

  • Arrangements(1).xlsm
    51.9 KB · Affichages: 2
Vote positif 0 Vote négatif
Gégé-45550

Gégé-45550

XLDnaute Accro
job75 à dit:
Bonjour Gégé-45550, TooFatBot, le forum,

Regardez attentivement le fichier joint et cette macro :
VB: 
Sub Tirages()
Dim t, ntirages&, i, j, k, n&, a(1 To 3)
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
'---liste des arrangements---
For i = 65 To 76
    For j = 65 To 76
        If j <> i Then
            For k = 65 To 76
                If k <> i And k <> j Then
                    n = n + 1
                    a(1) = Chr(i)
                    a(2) = Chr(j)
                    a(3) = Chr(k)
                    Cells(n + 1, 2).Resize(, 3) = a
                End If
            Next k
        End If
Next j, i
'---tris aléatoires---
[K2:M144].ClearContents 'RAZ
With [A1].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
        If Application.Max(Range("G2:I13")) <= 14 Then
            [K2:M144] = [B2:D144].Value
            Application.ScreenUpdating = True
            MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
            Exit Sub
        End If
    Next n
End With
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
100 000 tirages prennent du temps, pourtant ce n'est qu'à la 2ème tentative que j'ai obtenu un résultat.

Avec 67 000 tirages en 291 secondes.

A+
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Gégé-45550

Gégé-45550

XLDnaute Accro
Bonjour job75
Merci pour cette réponse. chez moi, j'obtiens
Capture.png

Malheureusement, le problème est plus complexe qu'il n'y paraît.
En effet, il ne s'agit pas de trouver seulement 143 arrangements répondant aux critères, mais bien d'arranger les 143 triplets pour qu'ils répondent aux critères.
Or si je prends le premier triplet de la liste imposée (AEJ), déjà il ne figure pas dans la liste des résultats obtenus.
C'est un vrai casse-tête sur lequel je bute depuis 2 semaines.
Merci de votre intérêt.
Cordialement
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Dans ce fichier (2) je pars de la liste imposée pour construire la liste des arrangements :
VB: 
Sub Tirages()
Dim t, ntirages&, d As Object, tablo, i&, x$, y$, z$, n&
t = Timer
ntirages = 100000 'nombre maximum de tirages, à adapter
Application.ScreenUpdating = False
'---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
        If Application.Max(Range("I2:K13")) <= 14 Then
            [M2:O144] = [D2:F144].Value
            Application.ScreenUpdating = True
            MsgBox Format(n, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.0") & " secondes", , "143 arrangements trouvés"
            Exit Sub
        End If
    Next n
End With
MsgBox "Aucun résultat en " & Format(ntirages, "#,##0") & " tirages..."
End Sub
On obtient 498 arrangements mais pas de solutions.

Si l'on passe la limite à 15 au lieu de 14 on obtient très vite une solution.
 

Pièces jointes

  • Arrangements(2).xlsm
    23.9 KB · Affichages: 3
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
J'ai mis dans le fichier (2) comme liste imposée en A2:A144 la liste des triplets obtenue avec le fichier (1).

Eh bien avec 3 essais de 100 000 tirages chacun je n'ai pas trouvé de solution.

L'algorithme utilisé n'est donc pas performant.
 
Vote positif 0 Vote négatif

Discussions similaires

ralph45
  • Question
Microsoft 365 Résolu [VBA] Suppression de sous-dossiers et dossiers vides
Réponses
6
Affichages
956
Dranreb
Dranreb
V
  • Question
XL 2013 [Résolu] Trop de UserForm! Schéma électrique
Réponses
7
Affichages
2 K
ChTi160
ChTi160
chostra
  • Question
Microsoft 365 problème navigation et selection dans Combobox-Liste de choix
Réponses
4
Affichages
2 K
chostra
chostra
Y
  • Question
XL 2019 Problème Calcul Tranches d'Âge et autres calculs Tableau de bord.
Réponses
0
Affichages
1 K
Yohan-L
Y
N
  • Question
Gestion de texte avec VBA et excel
Réponses
3
Affichages
890
Staple1600
Staple1600
N
  • Question
Repartition des stocks de produits aux ouvriers - Problème d'arrondi
Réponses
2
Affichages
1 K
Nakoulma
N
F
  • Question
Problème de copier/coller VBA
Réponses
4
Affichages
986
Flows
F
K
  • Question
Automatisation vba d'importation et de trie
Réponses
1
Affichages
708
krunt
K
moustic54
  • Question
Ecart, évolution et choix de graphiques
Réponses
1
Affichages
754
Misange
Misange
I
  • Question
Problème de version entre 2007 et 2010 (léger décalage de ligne)
Réponses
0
Affichages
1 K
Icolf
I

Membres actuellement en ligne

9 membres et 150 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 243
Messages
2 086 550
Membres
103 245
dernier inscrit
gdesign