Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Oui, effectivement, pendant la macro les lignes peuvent être changées d'ordre mais la restitution doit donner le même ordre dans les lignes.
Je pense à une méthode de maths (exclusion) pour y parvenir, sachant que des nombres associés sur une même ligne sont forcément en ligne alors que ceux qui ne sont jamais associés peuvent être dans une même colonne l'un au dessous de l'autre. Je ne sais pas par où commencer...
La formule calcule pour chaque colonne le nombre de valeurs différentes.
La méthode consiste à réaliser des tirages aléatoires des nombres de chaque ligne, formule en H1 :
Code:
=INDEX($A1:$E1;RANG(N1;$N1:$R1))
Pour déterminer le minimum en T2 on s'aide de cette macro très simple :
Code:
Sub Tirages()
Dim n&, mini&, i&
n = 10000 'nombre de tirages, modifiable
mini = 1000000000
Application.ScreenUpdating = False
'---détermination du minimum---
For i = 1 To n
Calculate
If [T2] < mini Then mini = [T2]
Next
MsgBox "Minimum trouvé " & mini
'---restitution du tableau---
While [T2] > mini: Calculate: Wend
End Sub
J'ai fait quelques essais, minimum obtenu 17, record à battre
Bien entendu il est plus que souhaitable de figer les résultats obtenus :
Code:
Sub Tirages()
Dim n&, mini&, h&, i&
n = 10000 'nombre de tirages, modifiable
mini = 1000000000
Application.ScreenUpdating = False
'---formules---
h = [A1].CurrentRegion.Rows.Count 'hauteur du tableau de départ
[H1].Resize(h, 5) = "=INDEX($A1:$E1,RANK(N1,$N1:$R1))"
[N1].Resize(h, 5) = "=RAND()"
[H1].Resize(h).Name = "a"
[I1].Resize(h).Name = "b"
[J1].Resize(h).Name = "cc"
[K1].Resize(h).Name = "d"
[L1].Resize(h).Name = "e"
[T2] = "=SUMPRODUCT(1/COUNTIF(a,a)+1/COUNTIF(b,b)+1/COUNTIF(cc,cc)+1/COUNTIF(d,d)+1/COUNTIF(e,e))"
'---détermination du minimum---
For i = 1 To n
Calculate
If [T2] < mini Then mini = [T2]
Next
MsgBox "Minimum trouvé " & mini
'---restitution du tableau---
While [T2] > mini: Calculate: Wend
[N1].Resize(h, 5) = [N1].Resize(h, 5).Value 'fige les valeurs
[H1].Resize(h, 5) = [H1].Resize(h, 5).Value
End Sub
Bien noter que les formules s'adaptent automatiquement au nombre de lignes du tableau de départ.
La formule en T2 a été simplifiée et utilise des plages nommées.
Une solution bien meilleure avec le stockage provisoire des résultats dans une plage auxiliaire.
Il y a donc maintenant 2 plages auxiliaires, en AA1 et BB1 :
Code:
Sub Tirages()
Dim n&, mini&, h&, i&
n = 100000 'nombre de tirages, modifiable
mini = 1000000000
Application.ScreenUpdating = False
'---formules---
h = [A1].CurrentRegion.Rows.Count 'hauteur du tableau de départ
[H1].Resize(h, 5) = "=INDEX($A1:$E1,RANK(AA1,$AA1:$AE1))"
[AA1].Resize(h, 5) = "=RAND()"
[H1].Resize(h).Name = "a"
[I1].Resize(h).Name = "b"
[J1].Resize(h).Name = "cc"
[K1].Resize(h).Name = "d"
[L1].Resize(h).Name = "e"
[N2] = "=SUMPRODUCT(1/COUNTIF(a,a)+1/COUNTIF(b,b)+1/COUNTIF(cc,cc)+1/COUNTIF(d,d)+1/COUNTIF(e,e))"
'---détermination du minimum---
For i = 1 To n
Calculate
If [N2] < mini Then mini = [N2]: _
[BB1].Resize(h, 5) = [H1].Resize(h, 5).Value 'stockage provisoire
Next
'---restitution du tableau---
[H1].Resize(h, 5) = [BB1].Resize(h, 5).Value
[AA1].Resize(h, 5) = "" 'RAZ
[BB1].Resize(h, 5) = "" 'RAZ
Application.ScreenUpdating = True
MsgBox "Minimum trouvé " & mini
End Sub
J'utilise 100.000 tirages, et j'ai pu obtenir assez facilement le minimum de 16.
Merci beaucoup pour ta macro. Moi aussi j'ai allongé la plage et augmenté les nombres (allant jusqu'à 70) et l'aléa n'a pas été totalement opérationnel, il faut dire que le nombre de permutations est grand....
je continue de penser à la méthode des nombres ensemble ou non: faire l'inventaire de toutes les "paires" possibles avec les nombres de la plage, repérer dans la plage les "paires" revenant plusieurs fois et les mettre sur leurs lignes respectives puis celles ne se trouvant nulle part et les mettre dans une même colonne ??
Merci ODVJ pour cette feuille (complexe, je n'ai rien compris...) j'ai une erreur 1004 sur la ligne "Sheets("générateur d'instance").Range("A6").Resize(nblig, 5).Copy" en lançant la macro calculs.
Par contre, en voyant ton calcul, le tableau est figé à 7 lignes; parfois j'en calcule une trentaine, à mon avis ce serait encore plus complexe!!
J'ai limité le générateur à 286 lignes (ne me demande pas pourquoi...)
Malgré le nombre de formules matricielles, le calcul du résultat engourdit à peine le PC.
Pour la macro qui plante, n'ayant pas ce problème, je t'en ai refaite une avec l'enregistreur de macro.
Remplace l'ancienne par celle-ci ;
Code:
Sub construit_calculs()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
nblig = [E2]
nblig_calcul = [nbData]
Sheets("calculs").Select
If nblig < nblig_calcul Then
Rows([mes_data].Row + 2 & ":" & [mes_data].Row + 1 + nblig_calcul - nblig).Select
Selection.Delete Shift:=xlUp
Else
If nblig > nblig_calcul Then
Rows([mes_data].Row + 2 & ":" & [mes_data].Row + 1 - nblig_calcul + nblig).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G" & [mes_data].Row + 1 & ":DE" & [mes_data].Row - 1 + nblig).Select
Application.CutCopyMode = False
Selection.FillDown
End If
End If
Sheets("générateur d'instance").Select
Range("A6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("calculs").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False
End Sub
Il faut savoir que cette macro ne calcule rien mais dimensionne simplement la zone de tes données (zone mes_data) et recopie l'instance générée aléatoirement (onglet générateur d'instance) dans tes données de la feuille calculs (zone mes_data)
Tu peux donc t'en passer et insérer/supprimer manuellement le nbre de lignes qu'il faut dans la zone de données.
Il ne faudra alors pas oublier de recopier les lignes de formules des colonnes cachées.
Remarque : en manuel, tu n'es plus limité à 286 lignes.
La macro est un confort pour éviter les manipulations.
Niveau qualité du résultat : on peut encore optimiser les calculs mais ça deviendrait un peu compliqué en formules.
Niveau modélisation : ta petite instance de 7 lignes laisse entrevoir d'autres approches :
On peut construire le graphe de compatibilité des sommets (valeurs de 1 à 10) pour en extraire une couverture par les arcs. On obtient le résultat que tu as fourni, l'ordre des colonnes pouvant changer.
Mais je n'ai pas poussé plus loin l'idée de l'utilisation d'un solveur.
Le fichier : cette fois-ci, j'ai mis la feuille de calcul simple (286 lignes) en fichier joint, sans macro de génération ni liste des arrangements.
Les formules : j'ai mis en formules un algo glouton qui vise à prendre dans une colonne l'élément qui offre le plus de remplissage puis celui qui, en dehors des lignes déjà choisie dans la colonne, offre à nouveau le plus de remplissage, etc..
Je passe ensuite à la colonne suivante.
Le reste, c'est de l'épicerie pour rendre les calculs plus "faciles".
J'ai limité l'algorithme à 6 niveaux. Je m'arrête donc à 7 valeurs différentes maximum par colonne.
On peut peut-être imaginer des instances qui passent à travers mes formules.
cordialement
edit : Quantification : chaque ligne de ton instance correspond à un des 30.240 arrangements 5 dans 10.
C'est ce que j'ai utilisé pour générer les instances dans le modèle complet : un ALEA.ENTRE.BORNE(1;30240) pour récupérer l'arrangement correspondant dans le tableau de 30240 lignes de la feuille Arrgts 4 et 5.
Si tu tries chaque ligne, tu ramènes le choix à 252 combinaisons 5 dans 10. fin edit
Merci pour cette nouvelle mouture, je comprends mieux!!
Malheureusement, ce n'est pas le nombre de lignes qui pose souci (une trentaine) mais l'étendue (50 ou 70 au lieu de 10) j'ai essayé d'insérer des colonnes dans le tableau masqué (passe) mais les formules en bleu sont ......complexes!
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.
