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

 

[Constantin]

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.
Il faut lire "dans la feuille "Listes"

 

[job75]

Bonjour Constantin, le forum,

Puisque "Find" va bien sur une plage sans formats effaçons les formats et restituons-les à la fin :

Private Sub Worksheet_Activate()
Dim etat, UR As Range, c As Range, cc As Range, P As Range, n&
Application.ScreenUpdating = False
etat = Application.CopyObjectsWithCells
Application.CopyObjectsWithCells = False 'les objets ne sont pas copiés
Set UR = Me.UsedRange
UR.Copy UR.Offset(UR.Rows.Count) 'copie pour mémoriser les formats
UR.ClearFormats 'efface les formats
For Each c In Sheets("Listes").[D2:D1000]
    If c <> "" Then
        Set cc = UR.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
UR.Offset(UR.Rows.Count).Copy UR 'restitue les formats
UR.Offset(UR.Rows.Count).Delete xlUp
If n Then P.Select: MsgBox n & " éléments trouvés"
Application.CopyObjectsWithCells = etat
End Sub

Hors messages la macro s'exécute chez moi en 2 secondes.

A+

 

[Constantin]

Bonjour Job75,
De fait ça va beaucoup plus vite. Si je comprends bien je dois copier cette macro dans l'éditeur VBA sur la feuille "Plan" ?
Avez-vous eu le temps de jeter un œil à la version du post#30 ? J'ai agrandi le plan pour caser les Hors Magasin etc... J'ai aussi résolu les problèmes liés à B265 et E2. Pour l'heure, j'ai utilisé la solution de mapomme qui a l'avantage de regrouper toutes les cellules non trouvées dans un seul message. Il n'y plus qu'à trouver une solution pour la recherche de mes points de collecte.
Je suis entrain de convertir les valeurs alphanumériques en nombres à 5 chiffres. Cela me permettra de sélectionner toutes les valeurs numériques sans passer par les tables dont le contenu est imprévisible. Il suffit que j'enrichisse de deux ou trois cellules une table un peu "pleine" pour qu'elle refuse d'intégrer ces nouvelles valeurs, d'où mon intérêt pour la macro de EssaiXYbis.xlsm.

A ce propos, j'ai plusieurs questions qui me chatouillent...
- Dans la macro "Grouper2", on ne voit apparaître aucune sélection de cellules ou de tables. J'imagine que la sélection concerne l'ensemble de la feuille. J'ai essayé de décortiquer le code mais j'avoue mes limites.
- Cette solution de sélection me semblant très efficace, je dois avouer que je ne saurai pas l'intégrer dans mon fichier Courses pour remplacer la ligne "Range("Données1... Données9") de la macro IdentifierPointsCollecte.
Vous avez bien compris, c'est un nouvel appel à l'aide et j'en suis confus
Quoiqu'il en soit, je suis réellement ravi d'échanger avec vous et mapomme.
Portez-vous bien !
Pierre

 

[job75]

Si je comprends bien je dois copier cette macro dans l'éditeur VBA sur la feuille "Plan" ?

Ma macro est une macro évènementielle, elle doit être placée dans le code de la feuillr "Plan".

 

[job75]

Votre gymnastique pour remplacer les textes alphanumériques par des nombres me paraît totalement inutile.

A condition que les textes alphanumériques soient constitués d'une lettre suivie de chiffres.

Voyez le fichier joint et cette macro :

Sub Grouper3()
Dim c As Range, P As Range
On Error Resume Next 'si aucune SpecialCell
For Each c In Cells.SpecialCells(xlCellTypeConstants)
    If IsNumeric(CStr(c)) Or IsNumeric(Mid(c, 2)) Then Set P = Union(IIf(P Is Nothing, c.MergeArea, P), c.MergeArea)
Next
P.Select
End Sub

Il faut savoir que IsNumeric(c) renvoie True si c est vide (Empty), c'est pour ça que j'ajoute CStr.

 

[job75]

On peut bien sûr appliquer cette dernière macro au fichier courses_couleur, c'est très rapide :

Private Sub Worksheet_Activate()
Dim c As Range, P As Range
On Error Resume Next 'si aucune SpecialCell
For Each c In Cells.SpecialCells(xlCellTypeConstants)
    If IsNumeric(CStr(c)) Or IsNumeric(Mid(c, 2)) Then Set P = Union(IIf(P Is Nothing, c.MergeArea, P), c.MergeArea)
Next
P.Select
End Sub

 

[Constantin]

C'est tout bonnement génial !
Là, c'est vrai, la galère de la conversion vers le tout numérique est parfaitement inutile... Je n'ai pas lâché le clavier depuis votre post#32.
Maintenant, il me faut intégrer cette jolie macro dans la macro "IdentifierPointsCollecte" pour qu'elle soit intégrée dans l'exécution de cette dernière... Je ne vous cache pas que je ne vois pas trop comment. Je vais faire des essais en espérant ne pas tout casser (ce serait trop dommage)
La macro en question :
Sub IdentifierPointsCollecte()

Dim TabCollectes() As Variant 'définition d'un tablo VBA

With Sheets("Sélection") 'avec la feuille 1
TabCollectes = .ListObjects("t_PointsCollecte").Range.Value 'on récupère les données de la table "t_PointsCollectes
End With

With Sheets("Plan").Range("Données1,Données2,Données3,Données4,Données5,Données6,Données7,Données8") 'avec les plages nommées "Données (1 à 8)"
With .Font 'on re ecrit tout en noir
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Size = 9 'pour me permettre de tout faire rentrer dans le plan quand je l'aurai finalisé
.Bold = False 'on supprime le gras par défaut
End With
With .Interior 'on supprime la coloration des cellules
.ColorIndex = 2 'choix pour l'instant
End With
For i = LBound(TabCollectes, 1) + 1 To UBound(TabCollectes, 1) 'pour chaque ligne de la table à partir de la ligne 3 (pour ignorer la ligne d'entete
If TabCollectes(i, 2) <> 0 Then 'si la colonne "Nb" <>0
Set trouve = .Find(TabCollectes(i, 1), lookat:=xlWhole) 'on cherche le code localisation dans la plage
If Not trouve Is Nothing Then 'si on le trouve
trouve.Font.Color = vbRed 'on écrit en rouge
trouve.Interior.ColorIndex = 27
trouve.Font.Bold = True
trouve.Font.Size = 11
End If
End If
Next i
End With
Sheets("Plan").Activate
End Sub
J'ai mis en gras ce qui me semble devoir être remplacé. Comment, je ne sais pas encore...

C'est parti !!!
Pierre

 

[job75]

J'ai eu du mal à m'y retrouver avec le fichier courses_couleur mais j'y suis arrivé :

- dans la feuille "Plan" 2 valeurs ne sont pas en colonne D de "Listes", C79 et M05

- en colonne D de la feuille "Listes" il y a 10 valeurs en doublon donc 240 valeurs uniques.

 

[Constantin]

C'est corrigé pour M05 et C79.
Pour les doublons, c'est parfois voulu... Plusieurs entrées peuvent correspondre à un même emplacement mais le contraire n'est pas vrai.
Exemple : C73 peut être activé par la sélection Déod. Femme ou Pansement (localisation sur un petit rayon)
Il y a d'autres doublons inutiles (B231 par ex.) mais que je ne sais trop comment supprimer (message quand j'essaye de supprimer la ligne). Pour autant, cela ne perturbe en rien la saisie semble t-il...

J'ai fait des essais sur la macro du précédent post (Sub IdentifierPointsCollecte()) ... La cata !
Bonne soirée
Pierre

 

[Constantin]

Bonjour Job75,
Je suis sur ma bécane depuis 6 heures ce matin...
J'ai travaillé avec la macro "Grouper3()" :
- insertion dans la feuille "Plan"
- appel dans IdentifierPointsCollecte par "Call Grouper3()". J'ai essayé plusieurs endroits...
-"neutralisation" du Range("Données...")
- j'ai essayé avec la deuxième macro "Private sub..."
Bref, je suis trop mauvais pour conclure ! (Erreur de syntaxe ou erreur de compilation)
En PJ, ma dernière mouture
Bonne journée

 

[Constantin]

Bonjour,
"Et le combat cessa, faute de combattants..." Rodrigue, dans la scène 3 de l'acte IV de la pièce de Pierre Corneille "Le Cid"
Je n'aurai donc pas de réponse(s) à mes questions. J'en suis chagrin...
Je vais donc arrêter de quémander en vous remerciant encore de votre patience.
Je clos donc cette discussion.
Bien cordialement,
Pierre