Répartir aléatoirement des objets dans un tableau + 1 contrainte

Bonjour

je tiens à préciser que je débute en VBA.

Cela fait plusieurs jours maintenant que je suis bloqué dans l'écriture d'un macro. Voici le contexte :

J'ai différents objets (A, B, C, D, E, ...). J'ai plusieurs exemplaires de ces différents objets. J’ai une feuille Excel nommée « informations » dans laquelle la première ligne correspond à une ligne de titre, la première colonne comprend les noms des différents objets et la deuxième colonne le nombre d’exemplaires pour chaque objet.

Je voudrais placer tous ces objets et leurs différents exemplaires dans un tableau de x lignes et y colonnes (dans une feuille "résultats").

La position des objets doit respecter une règle : il faut éviter que deux objets identiques ne soient adjacents l'un avec l'autre dans le tableau aussi bien horizontalement, verticalement que diagonalement. Et si ce n’est pas possible, il faut le moins possible d’objets identiques adjacents.

Exemple de données de départ:

Exemple de résultat attendu par la macro

Tableau 4x4, les objets sont répartis dans le tableau, il n'y a pas d'objets identiques adjacents (horizontalement, verticalement, diagonalement)

Actuellement, j'arrive à écrire une macro qui me génère un tableau(x, y), les objets sont répartis de manière aléatoire, mais je n'arrive pas à imposer la règle (objets identiques adjacents interdits)

J'ai des résultats du genre : E adjacents horizontalement; C adjacents diagonalement, B adjacents verticalement.

Quelqu'un pourrait-il m'aider à écrire cette macro, ou m'expliquer le raisonnement qu'il faudrait suivre ?

Merci

bonjour Phosphino,

je l'ai fait avec les colonnes D:E comme plage auxiliaire, comme ça, vous pouvez mieux suivre l'exécution. Normallement, je fais cela directement dans la mémoire, mais cela serait trop difficile pour vous pour comprendre.

Il faut normallement plusieurs essais pour une solution ...

Bj

on peut repeter automatiquement jusqu'à trouver une combinaison qui remplie toutes les cellules (si elle est possible)

re,

cela se voit dans le msgbox, "autant de boucles fait..." et on essaye max 100 fois.

Bonjour à tous

Un grand merci à BsAlv

La macro fonctionne correctement

Il faut en effet relancer la macro plusieurs fois pour avoir un tableau complet.

Je vais encore la tester en faisant varier différents paramètres.

Merci

re,

sorry, c'était un fichier intermédiaire

MERCI Beaucoup cela fonctionne très bien.

Je constate même en voyant la solution écrite que je n'ai pas les bases pour écrire ce genre de macro.

Est-ce que je peux me permettre encore une demande ?

Peux-tu m'écrire une nouvelle macro qui va analyser les résultats du tableau obtenu avec la macro précédente et qui va me donner pour chaque objet le nombre de fois qu'il est adjacent avec les autres objets. Les résultats seraient présentés sous forme d'une matrice symétrique.

Je reprend mon exemple de départ

Résultat obtenu avec la macro précédente

Résultat attendu par la 2ème macro

A n'est pas adjacent à A

A est adjacent 6 fois avec B, 3 fois avec C, 4 fois avec D, 5 fois avec E

B n'est pas adjacent à B

B est adjacent 6 fois avec A, 3 fois avec C, 4 fois avec D, 5 fois avec E

....

Merci de votre aide

re,

avec des formules qui utilisent Q2 et Q3 comme source et on les change au bout de la macro pour récupérer le résultat de S12.

Pour mieux comprendre la macro, vous pouvez débugger la macro pas-à-pas dans l'editor de VBA et puis on utilise chaque fois F8 et vous regardez les cellules des colonnes D:E et la plage K2:N5. La colonne D est le "pot" (comment appelez-vous cela en français) de tirage et dès qu'on a choisit un nouveau élément on le renvoit vers le bas de la colonne, donc le premier choisi sera dans D16 et K2, le 2ième D15&L2, le 3ième D14&M2, ... . La colonne E est une copie de la colonne D est represente le pot des éléments non-assignées.

Il y a maintenant une macro "attendre" avec un temps de délai de 0.5 sec (que vous pouvez modifier, 2 = 2 sec, 0.25 = 250 msec) pour que vous pouvez mieux suivre le système.

a priori je travail sur 365

J'ai testé la première macro avec un nombre d'objets inférieur à ce que peut contenir le tableau.

Exemple : tableau de 10 lignes et 10 colonnes. Nombre d'objets à placer 99.

Y a-t-il moyen d'éviter cette erreur ?

re,

aux spécialistes des formules 365, si vous pouvez créer ce tableau L13:P17 sans plages auxiliaires et VBA , ...

voir PJ de 15:30 et l'explication de Phosphino de 15:13

re,

je m'en vais maintenant, c'est pour ce soir.

re, 10*10 maintenant, ce serait quoi le max de lignes & colonnes dans le future ?

Bonjour BsAlv

Encore merci pour le temps consacré et l'aide que tu m'apportes à résoudre mes problèmes. Cette macro va me permettre de gagner énormément de temps. Aujourd'hui, ce travail de répartition des objets dans une grille est fait manuellement. Et c'est impossible de traiter bcp d'objets.

Le maximum d'objets&répétitions qui pourrait être traité est aujourd'hui de 900. Le max de lignes et de colonnes à envisager est de 30x30.

Dans la dernière version de la macro, je ne vois plus apparaître la matrice symétrique qui donne pour chaque objet le nombre de fois qu'il est adjacent avec les autres objets. Cette matrice doit permettre de voir si les objets sont répartis de manière homogène, qu'il n'y a pas, par exemple, trop souvent d'objets "B" adjacents aux objets "A".

Merci

re,

vous avez un exemple d'un 30*30 comme ça, surtout la distribution des objets (= ce tableau en colonnes A:B) ?

Ce sont quoi vos objets, des personnes ou ... ?

Oui, ce matrice n'était plus là, je ne savais pas où le positionner, donc maintenant que je sais votre 30*30, ... .

En manuel, cela prenait combien de temps ?

re,

une nouvelle version avec matrice symétrique. C'est combien la tolérance dans cette matrice entre le min et le max ?

Bonsoir, tt le monde

Bart, Pot en français peut être pot (aussi), vase, ou marmite, ici c’est plutôt marmite qui convient, depuis lundi je suis dans cette marmite ( ) j’ai pas fini avec F8, debug.prind …. Etc pour comprendre juste la première partie.

Pour msgbox "big problem" tu as dis que ça ne peut pas arriver ( ça me parait aussi logique) j l’ai enlever mais j’ai enlevé aussi deux lignes lorsque b=false

Cells(r, "E").Value = Cells(ptr1, "E").Value    'on déplace le dernier objet vers position r dans le pot auxiliaire
Cells(ptr1, "E").Value = .Cells(i, j).Value     'on déplace l'objet choisi vers la dernière position dans le pot auxiliaire

Parce que ce sont les mêmes objets qui vont rester sur lesquels on va faire le futur tirage au hasard non ?

ça veut dire que j’ai compris ou j’ai raté quelque chose en les enlevant ?

Concernant le remplissage avec tolérance de laisser quelque objet similaires adjacents, j pense peut se faire en sachant dire au programme à quel étape ne plus vérifier la règle et continuer à coller les objets restant.. ou bien définir un max de tolérance dès le debut sur

b = (WorksheetFunction.CountIf(.Cells(i - 1, j - 1).Resize(2, 3), Left(.Cells(i, j), 2) & "*") <=max)

re,

colonne E est la "marmite" des objets qui ne sont pas encore assignés et le but est de faire un tirage au sort de cette marmite, mais si ce tirage est faux à cause d'adjacent, on enlève cet objet de la marmite (=objet dans la poubelle) et on refait le tirage avec un objet en moins. De telle manière, on teste toutes les possibilités avec le moindre effort. Donc, si le drapeau "b" est faux, et pour visualiser, le tirage est le 4ième de 8 (E1:E8) = cellule E4 est pour la poubelle et E8 sera déplacé vers E4 et on refait le tirage avec 7 objets. Résultat nouveau : E2 et le drapeau est de nouveau faux, E2 = poubelle, E7 est déplace vers E2 et on continue avec 6 objets, ... . On fait cela jusqu'au moment où le drapeau "b" est vrai ou tous les objets sont dans la poubelle. Dans ce dernier cas, on recommence à zéro dans un nouveau iLoop. Si le drapeau est vrai, mais comme x objets de la colonne E sont déjà dans la poubelle et le reste est déplacé un peu aléatoire , la séquence de E ne correspond plus aux cellules "noires" de D. C'est pourquoi ce match, que vous avez désactivé, est là. A ce moment, le drapeau "B" est vrai pour l'objet E2 de la marmite auxiliaire qui est le même que l'objet D6 de la marmite principale. Vous comprenez ?

donc avec ceci on crée la marmite auxiliaire

With Range("D1").Resize(ptr)
    .Offset(, 1).Resize(iTot).ClearContents
    .Offset(, 1).Value = .Value     'créer une copie de nos objets avec nouvelle dimension ptr (non asignés)
End With

et puis on fait son boulot dans cette marmite et dépendant du résultat, on ajuste la marmite principale (drapeau "VRAI") ou on recommence de zéro (tous les objets dans la poubelle).

Vous comprenez ce principe du "moindre effort" avec ce poubelle ? C'est inutile de laisser un objet dans la marmite auxiliaire, une fois faux reste faux pour l'éternité et on continue avec un objet en moins.

re,

concernant cette matrice symétrique, le résultat est par exemple min = 31 et max 39. Je n'ai pas vraiment un système d'optimalisation pour réduire cet écart, mais je peux refaire cette répartition 10 fois et choisir le meilleur ... .

je voudrais avoir un exemple de 30x30, si le nombre d'objets différents (nombre de lignes du tableau en colonnes A:B) est suffisant, cela sera peut-être plus facile qu'un 10x10.

re,

en expliquant, il y a un moment, je me demandais pourquoi la complexité de 2 marmites et oui, c'est possible avec une marmite, cela sera pour la prochaine version ...