Une solution "Plus rapide"

Bonsoir @ tous !

le titre ne dit pas grand chose alors que j'ai le lien sur les règles du forum....

Mais je ne savais quoi mettre...

Toujours est-il que j'ai un fichier avec un code VBA, un bouton pour lancer le code, celui écrit fonctionne mais il met "trop" de temps à mon goût, je ne dois pas utiliser la bonne méthode !

La situation : une grille de cellules, avec un cadre noir

Dans cette grille une cellule verte.

La grille est découpée en deux morceaux sans que cette découpe soit "ordonnée" par une ligne bleue.

Je clique sur le bouton "Allons-y !"

Mon code actuellement scanne toutes les cellules de la grille est il met en "vert" les cellules qui sont "blanches" et qui sont adjacentes à une cellule verte existante. Donc au premier tour de scan (dans le cas précis du fichier joint) il va trouver 4 nouvelles cellules.

Comme il y a des nouvelles cellules, la boucle Do / Loop est relancée est le scan également.

Chaque cellule passée en vert sont ajoutées à la variable "Cellule".

Une fois sortie de la boucle Do /Loop lorsqu'il n'y a plus eu de cellule nouvelle trouvée, la grille est passée entièrement en rouge,

puis la cellule verte du départ (L13) passe en vert, puis la plage "Cellule" en vert également.

Une deuxième boucle transforme le rouge qui ne touche par de vert en blanc ou en noir si elle touche du vert.

Le fichier :

J'ai "supprimé" le ScreenUpDating pour que vous puissiez suivre les évolutions de ma méthode, car les explications ne sont peut-être pas claires...

Je n'arrive pas à accélérer ce processus, je dois donc trouver une autre méthode... Et c'est là que vous intervenez...

J'ai pensé à "transférer" l'équivalent de la grille en tableau VBA pour travailler dessus en VBA, mais je n'ai pas réussi à concrétiser mon essai...

Attention ! Après le test, il n'y a pas de bouton pour tout remettre en état...

Merci par avance,

@ bientôt

LouReeD

Bonjour,

que faut-il comprendre par

sans que cette découpe soit "ordonnée" par une ligne bleue.

Elles y sont ou pas ces cellules bleues ?

eric

En fait ce que je voulais dire c'est que la ligne bleue n'est pas forcément rectiligne et qu'elle peut avoir des "allers/retours" au niveau de la direction, qu'elle peut commencer de n'importe quel coté est arriver sur n'importe lequel...

En ligne rectiligne de bord opposé, cela aurait été plus simple car la cellule verte serait soit à droite ou à gauche de la ligne bleue ou bien en dessous ou au dessus, mais avec des tours et des retours, la cellule peut très bien être entouré de bleu et là j'ai du mal à voir comment faire si ce n'est ma première proposition... Mais qui réclame un peu de temps de calcul... Alors je peux gagner un peu de temps en travaillant "en diagonal" pour la recherche de zone comme je le fait sur la deuxième partie du code... Mais non

Ci joint le fichier avec une nouvelle découpe de la ligne bleue :

Et la modification du code pour ajouter les diagonales... Mais ce n'est vraiment pas mieux !

@ bientôt

LouReeD

ce qui te coûte cher c'est la lecture des couleurs.

Les lire toutes une seule fois dans un tableau pour travailler dessus.

J'ai déjà fait cette partie :

Sub test()
Dim nbLig As Long, nbCol As Long, tabl() As Long
Dim c As Range, lig As Long, col As Long, i As Long
    Application.FindFormat.Clear
    Application.FindFormat.Interior.ColorIndex = xlNone
    Set c = Columns(1).Find(What:="", SearchFormat:=True)
    If Not c Is Nothing Then nbLig = c.Row - 1 Else GoTo erreur
    Set c = Rows(1).Find(What:="", SearchFormat:=True)
    If Not c Is Nothing Then nbCol = c.Column - 1 Else GoTo erreur
    ReDim tabl(1 To nbLig, 1 To nbCol)
    For lig = 1 To nbLig
        For col = 1 To nbCol
            tabl(lig, col) = Cells(lig, col).Interior.Color
            If tabl(lig, col) <> vbBlack And tabl(lig, col) <> 16777215 Then
                ' ni contour, ni vide
                ' mémoriser si vert, ça pourra servir
Stop
            End If
        Next col
    Next lig
    Exit Sub
erreur:
End Sub

Après reste à réfléchir si on peut trouver un autre algorithme plus efficace...

Mais avec ce temps d'été, les heures excel sont réduites

eric

Bonjour,

Une solution en pièce jointe.

Travailler sur un Array,

Eliminer les Redim, Offset et autres Resize...

A+

Bonjour @ tous !

Merci eriiic, galopin07 pour ces codes.

Bon celui d'eriiic m'est moins accessible.. Et celui de galopin07 galopin01 ! est clé en main.

Par facilité j'ai retravailler celui de galopin07 galopin01 ! .

En effet, le fichier test ne reprenait toutes les contraintes, et il induisant une erreur avec la mise en blanc des cellules du coup le code provoquer une erreur lors d'un deuxième lancement. Et j'ai ajouté ne couleur de "tapis" et la suppression des bordures noires inutiles.

Donc maintenant, une fois le code lancé il ne reste plus que la cellule verte dans sa zone blanche, clôturé par une bordure noire et le reste de la zone totale est violette !

Donc un grand merci à vous.

Dès que je suis sur mon ordi je mettrais le fichier pour montrer le résultat...

J'aime bien l'idée de la recherche de la taille de la zone dans le code d'eriiic, mais avec le "tapis" elle devient caduc...

@ bientôt

LouReeD

Bonjour,

Tu remarqueras que je n'ai fait qu'optimiser ton code... Car je n'ai pas du tout réfléchi au truc...

Bien que cela soit déjà acceptable au niveau rapidité il me semble possible de diviser encore par 10 le temps d'exécution en adoptant :

• un module de classe
• l'algo inverse pour le parcours de l'array au lieu de considérer la cellule en cours dans la boucle Do/Loop on va considérer les 8 autres qui la cernent et on affectera à ces cellules une valeur de couleur (pour l'Array) Au lieu de "baptiser" une cellule à chaque visite, on va en baptiser 9...) Avec en bonus un codage un peu plus clean.
• Ce qui précède suppose qu'on travaille avec .ColorIndex et non RGB (pour des raisons évidentes...)

A+

Bonjour,

J'ai essayé le code avec test des diagonales pour la recherche de zone "verte" mais il n'y a pas eu de gain de temps.

Un temps moyen de 0,15 est pour moi très correcte !

Merci pour votre ténacité dans la recherche "d'un découpage" plus rapide.

Il me faut du temps pour relire et comprendre votre message pour ce qui est module de classe et l'algo inverse...

@ bientôt

LouReeD

Bonjour,

B

on celui d'eriiic m'est moins accessible..

en même temps je n'avais fait que 1/100e de ce qu'il fallait, juste la détermination de la plage de travail

Posté vite fait avant le lit.

Me revoilà avec une technique qui n'a plus rien à voir, je travaille avec des plages complètes plutôt que cellule par cellule.

• une 1ère passe qui prend les cellules vides et nous fournis des areas.
• une série d'autres qui regroupent les areas jointives. Ca boucle tant qu'on peut faire des regroupements.

Sur ton exemple on termine avec 2 plages. Mais tant que j'y étais j'ai fait plus générique. Il peut tout aussi bien y avoir 6 ou 10 plages séparées, no limit

Pour tester, cliquer sur ton bouton 'Allons-y'. Je sélectionne les plages générées pour les visualiser une par une.

Je ne met pas de couleurs, comme tu as les range dans un tableau tu peux en faire ce que tu veux facilement.

J'avoue que je ne suis pas mécontent de l'idée et de la réalisation

Si tu pouvais comparer et me dire...

eric

Edit : fichier modifié. Il manquait un Dim k, je ne sais pas pourquoi je n'ai pas eu l'erreur avant (?!?)

Bonsoir eriiic !

Oui cela m'épate, je vois bien la sélection cumulative de rectangle, et avec un timer, cela descend sur ma machine à 0.09.

Il reste la mise en couleur qui devrait prendre un peu de temps.

Par contre, comme l'a dit galopin07 galopin01 ! , il a "optimisé" mon code (si on peut l'appeler comme cela ), du coup j'arrive mieux à le déchiffrer.

Première partie du code pour la dimension de la zone, ceci j'arrive à le comprendre, la deuxième partie : le scan de la zone, cela va aussi, mais je perd pied dès qu'il faut attaquer la fonction

Le résultat des différente zone est là, il faut que j'ajoute la mise en couleur et la transformation du bleu en noir car les cellules qui bordent la zone du vert deviennent la "nouvelle bordure" de la plage.

Donc merci à vous deux pour ces deux propositions : une amélioration et une autre façon de voir, et si galopin07 galopin01 ! a du temps, alors il devrait y avoir une troisième avec des "class" et j'en passe des meilleurs.

Toujours est-il que le projet avance, avec de nouvelles contraintes au fur et à mesure que j'avance, comme celle où il peux y avoir deux voir trois ou quatre cellules vertes, donc il peut y avoir "séparation du groupe" et du coup aucune des deux zone ne change de couleur... Bref, grâce à vous je pense pouvoir m'en sortir, et sachez le : si j'ai besoin je reviens !

@ bientôt

LouReeD

mais je perd pied dès qu'il faut attaquer la fonction

En fait le principe est simple.

L'idée est que 2 plages ne sont jointives que si la 1ère et la 2nde décalée d'un cran se chevauchent.

Je fais donc l'intersection de la 1ère, avec les 4 décalages possibles (haut, bas, gauche, droite) de la 2nde.

Si au moins une intersection n'est pas vide, c'est qu'elles étaient jointives. On peut faire l'union et diminuer le 1 le nombre de plages. On recommence jusqu'à ce que plus aucune agrégation ne puisse se faire et obtenir ainsi la liste des plages disjointes.

L'avantage c'est qu'on passe de 1000 cellules à 10 plages à comparer. Si tu doubles les dimensions de ton tableau tu passeras à 4000 cellules, alors que les areas ne seront peut-être encore que 10 et le temps variera peu.

Et 40% de gain c'est pas mal je trouve, même si c'est peanuts sur un temps déjà court

eric

Bonsoir,

vite fait en passant, le fichier " galopin07 galopin01 ! " :

@ bientôt

LouReeD

PS : je viens de voir qu'il reste un Union(plJoint(i), plJoint(j)).Select qui me servait aux contrôles dans la fonction.

A supprimer

PS2 :

Je viens de jeter un oeil et de comparer les versions. C'est même beaucoup plus conséquent que ce que je pensais la différence sur ce dessin.

Je passe de 6.9s à 0.1s.

Ce n'est pas le changement de couleur de 3 plages qui changera grand chose

Et j'ai oublié un paquet de Set plageX = nothing pour que ce soit plus propre...

PS3 : je considère les cellule verte comme vides, ça ne pose pas de problème si tu en as plusieurs. Par contre seule la dernière est prise en compte pour repérer la plage