XL 2021 Paramètres de "Range" en VBA

[Constantin]

Bonjour,
Dans le fichier joint, ouvrez la macro "IdentifierPointsCollecte"...

A l'origine (grâce à la contribution éclairée de plusieurs d'entre vous), la sélection des cellules à prendre en compte correspondait à [Plan_Magasin] ce qui avait le désagrément de supprimer toute la colorisation (fond et police) de la feuille "Plan".

J'avais pour objectif d'épargner les cellules relatives au "mobilier" pour ne modifier que les cellules relatives aux emplacements (Ex : A000, B50...)
En tâtonnant, j'ai créé des tables (Données 1 à 7) que j'ai regroupées dans l'objet Range. J'ai du faire plusieurs tables parce que le contenu de chaque table ne pouvait contenir qu'un nombre limité de cellules ou de pavés de cellules.

Mes questions après de nombreuses recherches infructueuses sur les forums :
- Quels sont les paramètres à prendre en compte pour créer des tables contenant des cellules ou pavés de cellules séparées (qualitatifs et quantitatifs)
- Combien peut-on insérer de tables (ou références) dans l'objet "Range"

Si vous pouvez m'éclairer...

Joyeuses Pâques !

Pierre

 

[mapomme]

Bonjour @job75,

D'expérience je peux vous dire que la fonction Union ne pose pas de problème pour unir quelques centaines de zones disjointes.

Au delà de 1000 zones elle prend beaucoup de temps.

Il est vrai qu'UNION prend du temps machine à partir d'un certain seuil.

Une méthode que j'avais trouvée pour diminuer la durée était de passer par des Range dont les adresses sont inférieures à 255 caractères. Le code est quelque peu rallongé.

Voir le classeur joint :

• Test n°1 -> chaque cellule fait l'objet d'une UNION
• test n°2 -> on fait des UNION par paquets de cellules

Je m'interroge pour savoir si d'aucuns ont trouvé d'autres méthodes pour rendre UNION plus rapide.

remarque : la méthode que j’emploie devient de plus en plus inefficace au fur et à mesure que les cellules en cause se situent vers la droite et vers le bas. En effet la taille de chaque adresse de cellule a tendance à augmenter et donc la taille des paquets diminuent et par conséquence le nombre d'UNION augmente.

Le code dans le module de "Feuil1" :

Sub test2()
Dim i&, j&, n&, s, t(), xrg As Range, deb
   [a1].Select
   deb = Timer
   For i = 1 To 200 Step 2
      For j = 1 To 39 Step 2
         s = s & "," & Cells(i, j).Address(0, 0)
         If Len(s) > 240 Then: n = n + 1: ReDim Preserve t(0 To n): t(UBound(t)) = s: s = ""
      Next j
   Next i
   If s <> "" Then ReDim Preserve t(0 To UBound(t) + 1): t(UBound(t)) = s: s = ""
   If t(1) <> "" Then Set xrg = Range(Mid(t(1), 2))
   n = 0
   For i = 2 To UBound(t): n = n + 1: Set xrg = Union(xrg, Range(Mid(t(i), 2))): Next
   xrg.Select
   MsgBox "Durée exécution avec " & n & " UNION : " & Format(Timer - deb, "#,##0.00\ s")
End Sub

 

[Constantin]

Bonsoir Mapomme,
Quel travail ! Le test 2 est presqu' instantané. Malheureusement, mon niveau ne me permet pas de comprendre tout ce code. Si je demandais gentiment, vous pourriez m'expliquer ? Mais vous avez du y passer déjà beaucoup de temps.
Pour en revenir à mon questionnement, comment adapter cette formule pour des cellules éparpillées ?

Mon bazar ne risque t-il pas de ressembler à une usine à gaz ? Je ne vois toujours pas comment saisir des éléments éparpillés comme dans mon fichier EssaiXY (feuille Y).

Entre les propositions de Job75 et les vôtres, mes journées vont être bien remplies...

Bonne soirée, et encore merci !

Pierre

 

[job75]

Pour le fichier du post #15 utilisez :

Sub Grouper2()
Dim c As Range, P As Range
On Error Resume Next 'si aucune SpecialCell
For Each c In Cells.SpecialCells(xlCellTypeConstants)
    If c <> "" Then Set P = Union(IIf(P Is Nothing, c.MergeArea, P), c.MergeArea)
Next
P.Select
End Sub

 

[Constantin]

Merci encore job75 pour cette macro qui me sera fort utile dans un autre fichier mais hélas pas dans "Courses_couleur" (voir post#1)
Cette belle macro sélectionne, si j'ai bien compris, les cellules qui contiennent quelque chose. Or mon "Plan" contient évidemment des blocs de cellules qui sont renseignées donc qui seront sélectionnées au même titre que celle qui contiennent les références d'emplacement qui sont les seules que je veux sélectionner pour les soumettre à l’exécution de la macro "IdentifierPointsCollecte".
D'après ce que j'ai lu et essayé de comprendre "Union" résonne comme un analyseur d'intersections.
Il ne peut s'intéresser à la nature du contenu de la cellule. Dans mon cas (Courses_couleur), il faudrait que je puisse identifier les cellules qui contiennent un ou plusieurs chiffres (Ex : C21, V00, C51...) mais là, je ne sais pas si c'est possible. Je vais chercher de mon côté (avec un coup de chance ?)
J'ai fait un test sur EssaiXYbis. Je joins aussi Courses_couleur au cas où... (vous connaitrez ma liste de courses pour Pâques )
Merci encore de votre patience et de vos connaissances impressionnantes.

Bonne journée

Pierre

 

[job75]

Bonjour Constantin, le forum,

Pour rechercher les cellules qui contiennent des constantes de nombres ajouter l'argument 1 :

For Each c In Cells.SpecialCells(xlCellTypeConstants, 1)

Pour rechercher des textes ce sera 2 :

For Each c In Cells.SpecialCells(xlCellTypeConstants, 2)

A+

 

[Constantin]

Super ! J'essaye tout ça et j'essaye de l'intégrer dans mon plan.
J'étais en train d'essayer avec "if contains" mais je n'ai pas trouvé l'équivalent en français même après avoir installé le complément traducteur de fonctions.
J'ai testé sur EssaiXYbis, concernant les chiffres,c'est exactement ce que je cherche ! Par contre mes références intègrent des lettres et là, ça ne marche pas.
Reste à savoir comment je vais intégrer ce code dans ma macro IdentifierPointsCollecte mais avant tout, s'il n'y a pas de solution pour identifier les cellules qui contiennent un ou plusieurs chiffres, il me reste la possibilité de transformer mes références en chiffres. J'essaye ça ! mais je pense que j'aurai besoin d'un petit coup de main pour intégrer le code dans mon Range.

A suivre !!!
Pierre

 

[job75]

Pour ce qui est de votre liste de courses mettez cette macro dans la feuille "Plan" :

Private Sub Worksheet_Activate()
Dim c As Range, cc As Range, P As Range, n&
For Each c In Sheets("Listes").[D2:D1000]
    If c <> "" Then
        Set cc = Cells.Find(c, , xlValues, xlWhole)
        If cc Is Nothing Then
            MsgBox c & " pas trouvé"
        Else
            Set P = Union(IIf(P Is Nothing, cc, P), cc)
            n = n + 1
        End If
    End If
Next
If n Then P.Select: MsgBox n & " éléments trouvés"
End Sub

Elle se déclenche quand on active la feuille.

 

[job75]

Dans mes premiers essais la macro précédente s'exécutait rapidement.

Maintenant elle met beaucoup de temps, je ne sais pas pourquoi.

Et chez vous ?

 

[mapomme]

Bonjour @job75, @Constantin,

Dans mes premiers essais la macro précédente s'exécutait rapidement.
Maintenant elle met beaucoup de temps, je ne sais pas pourquoi.

Pour accélérer la chose, j'ai remplacé le "FIND" par une recherche dans un "dictionary". La durée d'exécution en est diminuée.

Le code dans le module de la feuille "Plan" :

Sub Worksheet_Activate()
Dim c, cc, P As Range, n&, k&, s$, dico As Object, t, x
 
   ' init
   Application.ScreenUpdating = False
   s = "Liste des absents:"
 
   ' dictionary des références potentielles sur le plan
   Set dico = CreateObject("scripting.dictionary")
   dico.CompareMode = TextCompare
   For Each cc In Sheets("Plan").Range("b2:fv100").Cells
      x = Trim(cc.Value)
      If x <> "" Then If Len(x) < 7 And x Like "*#" Then dico(x) = cc.Address(0, 0)
   Next cc

   ' P => Union des adresses correspondant à des références trouvées
   ' s => Liste des références non trouvées
   For Each c In [t_Listes].Columns(4).Value
      If Trim(c) <> "" Then
         If dico.Exists(c) Then
            n = n + 1
            If n = 1 Then Set P = Range(dico(c)) Else Set P = Union(P, Range(dico(c)))
         Else
            k = k + 1
            s = s & vbLf & c
         End If
      End If
   Next c
 
   ' sélection et information
   If n Then P.Select Else [a1].Select
   ActiveWindow.ScrollRow = 1: ActiveWindow.ScrollColumn = 1
   Application.ScreenUpdating = True
   MsgBox "Nombre d'éléments présents : " & Format(n, "#,##0") & vbLf & _
      "Nombre d'éléments absents : " & Format(k, "#,##0") & vbLf & vbLf & s
End Sub

 

[Constantin]

Bonjour mapomme, bonjour job75,
Je suis réellement impressionné. Cette macro fonctionne très bien. Elle m'a d'ailleurs permis de corriger 2 petits oublis (E2 et B265).
Il me reste à tester la macro proposée par Job75 (pour l'heure, je suis de corvée de courses justement...)
Indépendamment de vos deux travaux, je suis entrain de modifier les références de mes points de collecte en chiffres purs et durs (c'est long, très très long)...
Bien cordialement,
Pierre

 

[mapomme]

Il me reste à tester la macro proposée par Job75

La macro de @job75 fait la même chose et je m'en suis inspiré. C'est simplement la méthode que j'ai modifiée.

Attention ! Si vous modifiez toutes les références alphanumériques pour des nombres ma macro ne fonctionnera plus. Il faudra légèrement l'adapter .

 

[Constantin]

Hello !
J'ai testé la macro de Job75... J'ai cru que mon ordi était en panne
De fait, ça rame vraiment dur.
Si le fait de remplacer les localisations de la feuille Listes par des chiffres bloque la macro, je vais rester sur mes Range("Données1 à 8) donc sur la version transmise par mapomme (j'ai du mal à m'y faire)...
Sans abuser, qu'y aurait-il à modifier dans la macro de mapomme pour qu'elle accepte des chiffres et non des caractères alphanumériques ?
En vous demandant d'excuser mon si faible niveau de compétence...
Bien à vous,
Pierre

 

[job75]

J'ai testé la macro de Job75... J'ai cru que mon ordi était en panne
De fait, ça rame vraiment dur.

La méthode "Find" n'est pas très rapide mais en plus ici la feuille "Plan" est très tarabiscotée.

Si l'on efface tous ses formats la macro s'exécute chez moi en 1,3 seconde.

 

[mapomme]

Re @Constantin,

Une version v2 qui doit fonctionner pour du texte, des nombres ou un mélange des deux.
Pour les nombres, je n'ai pas vérifié car je n'ai pas le classeur idoine pour les tests.

Question : pourquoi passer en nombre ?

 

[Constantin]

La méthode "Find" n'est pas très rapide mais en plus ici la feuille "Plan" est très tarabiscotée.

Si l'on efface tous ses formats la macro s'exécute chez moi en 1,3 seconde.

Bonsoir Job75 et bonsoir mapomme,

Je suis bien d'accord... L'organisation des rayons de mon Leclerc est digne du père UBU (ne l'oublions pas, Alfred Jarry était mayennais comme moi je le suis devenu) et puis j'aime bien la couleur

Ma logique est simple :
- je suis une personne à mobilité réduite donc je limite mes trajets lorsque je fais mes courses (même si mon toubib n'est pas d'accord)
- j'ai organisé ma cueillette du bas à droite (entrée du magasin) pour ensuite remonter sur ce côté droit, me rabattre vers la gauche, redescendre et enfin accéder aux caisses.
- j'évite ainsi les achats compulsifs (bof) et surtout les allers et retours dans le magasin
Vous m'avez envoyé un fichier très intéressant que j'ai complété lors de mon Post#19 (EssaiXYbis)
Il apparaissait que l'on devait faire un choix entre alphanumérique ou numérique au sens strict puisqu'on ne pouvait sélectionner des cellules alphanumériques comprenant des chiffres.

Je me suis dit (sans doute bêtement) qu'il suffisait de remplacer les valeurs alphanumériques de mes champs de localisation dans la feuille "plan" (fichier Courses déf joint) par des nombres pour pouvoir exécuter la macro "grouper" de "EssaiXYbis". Sur ce fichier, cette macro fonctionne super vite, d'où mon idée de la transposer dans mon fichier courses.
Problème : L'alphabet comporte 26 lettres ce qui implique une numérotation à 5 chiffres pour conserver une logique de rayon et pouvoir compléter le plan qui est loin d'être finalisé.
Exemple : Habillage -> Rayon et rien d'autre alors qu'il y a au moins 10 déclinaisons à ajouter (chaussures, accessoires, slips, homme, femme...). Dans ce cas précis, V00 deviendrait 22000 (22 pour V).
Mais pourquoi 5 chiffres ? Pour me laisser la possibilité d'insérer et d'intercaler dans une travée ou une zone une référence supplémentaire sans pour autant perturber la logique de cueillette et de cheminement. C'est ainsi que l'on retrouve dans ma "Listes" des références telles que : B342 qui deviendrait 2342 ou M049 qui deviendrait 13049.
La liste ou table "Plan_magasin" ne contiendrait plus alors que des des cellules alphanumériques (ex : "Cocottes Yaourtières"; "PARFUMERIE") qui seraient épargnées par la macro " grouper" ou des cellules numériques au sens strict qui seraient concernées par la macro "IdentifierPointsCollecte".

J'ai commencé mes saisies sur une base de 999 chiffres mais je perds la possibilité d'introduire des points de collecte sans mettre une pagaille monstrueuse dans le fichier liste.
En plus le remplacement des cellules alphanumériques par des cellules numériques nécessite un temps de traitement particulièrement pénible. Je vais essayer de désactiver les macros pour procéder aux remplacements.
Je vous tiendrai bien sûrs informés,
Mille mercis
Pierre