Discussion :

[unparia]

Bonjour
Je souhaite pouvoir supprimer d'une plage spécifiée de cellules pouvant être discontinues les cellules d'une autre plage pouvant elles également être discontinues.
Et ce : quels que puissent être ou avoir été les critères (non forcément existants, d'ailleurs) de constitution de chacune de ces deux plages (sans donc chercher à les utiliser)
Je sais bien évidemment accomplir cette opération en bouclant sur les "areas", etc ...
Mais je cherche à éviter un tel mécanisme (assez fastidieux) et à lui substituer un mécanisme plus "direct", sans utilisation de boucles.
Quelqu'un a-t-il déjà eu à mettre en place un tel mécanisme ?

Je ne manquerai pas, si j'y parviens (j'ai une petite idée), de dire comment je m'y suis pris.

EDIT : clarification : il ne s'agit pas de suppression effective, mais de la détermination de la plage résultante (sans toucher, donc, aux cellules sur la feuille, qui doivent rester intactes et dans leur état originel in fine, formules et formatage inclus)

[Jean-Philippe André]

Bonjour,

malgre la clarification, j'ai toujours rien bite a ce que tu racontes =]

Mis a part les 2 plages discontinues, je ne comprends pas ce que tu cherches a faire.

Tu as une plage A et une plage B, OK, mais qu'est-ce qui est sense determiner quoi ??

[RyuAutodidacte]

Bonjour,
Je pense avoir compris et visualiser ce que tu veux dire, mais c'est qd même pas évident de comprendre; il faut faire un gros effort.
et comme l'exige les règles du forum sur la clarté de la demande … (t'inquiète je plaisante )
Par contre un exemple serait un plus afin de mieux appréhender le problème (en tout cas pour ma part)

[unparia]

Bonjour Jean-Philippe André

Tu as une plage A et une plage B, OK, mais qu'est-ce qui est sense determiner quoi

Tout "simplement" (si tu veux) ce qui reste de la plage A lorsqu'elle n'inclut plus (lorsqu'on lui "soustraie" les cellules de la plage B qu'elle peut contenir )
Exemple très simplifié avec des cellules continues (pour que tu comprennes de quoi il s'agit)
Addresse de la plage A : $A$1:$A$10
Addresse de la plage B :$A$3
Addresse de la plage résultante : $A$1:$A$2,$A$4:$A$10
Voilà. Mais cet exemple est un exemple volontairement simple, juste pour que tu voies de quoi il s'agit.
C'est que que je veux mettre en place (sans boucles) , mais pour des plages bien plus complexes (discontinues).

[Jean-Philippe André]

OK, dans l'idee tu feras une double boucle for each en principe, mais la difficulte reste que le for each se fait dans un ordre croissant et du coup la suppression ne peut se faire dans la boucle, mais en passant par un collection d'adresse que tu supprimeras apres la double boucle.

Sur le papier, ca donnerait un truc comme ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim Col as New Collection
For each c in Range("PlageA")
    For Each d in range("PlageB")
If c.Value =d.Value Then Col.Add c.Address
Next
Next
For i = Col.Count To 1 Step -1
Range(Col.item(i)).Delete
next i

[unparia]

OK, dans l'idee tu feras une double boucle

Euh ...
Avec des boucles, je sais faire (et l'ai dit) ..
C'est sans aucune boucle, que je souhaite y parvenir !
Pour mémoire (dans mon tout premier message) :

Je sais bien évidemment accomplir cette opération en bouclant sur les "areas", etc ...
Mais je cherche à éviter un tel mécanisme (assez fastidieux) et à lui substituer un mécanisme plus "direct", sans utilisation de boucles.

EDIT : et il ne s'agit pas du tout de comparer des valeurs, ni de supprimer des cellules. Il s'agit de déterminer la plage résultante, sans rien modifier des cellules.

[Jean-Philippe André]

Hum, tu penserais a quoi exactement du coup ?

[unparia]

Hum, tu penserais a quoi exactement du coup ?

A ce que j'ai exprimé.
Si maintenant le sens de ta question est "Pour en faire ensuite quoi ? ". Pour l'utiliser au sein d'un autre mécanisme assez particulier (mais cet aspect-là est totalement autre).
Bon ...
je crois que je vais continuer seul. J'en suis à l'étape de "construction" d'un "pseudo-algo" (succession de manipulations) qui me donne à penser que je vais y parvenir.
Si j'y parviens (je verrai cela ce soir en transposant en code mes idées) je "mettrai" ici le code d'un tel mécanisme (il sera probablement difficile à suivre sans avoir été précédé de réflexions, mais ...il fonctionnera).

EDIT : j'aurais peut-être été plus clair en disant que je souhaitais faire l'inverse de ce que fait Application.Union ?
J'ai hésité à le dire ainsi (il me semble que l'on aurait probablement encore moins compris).

[halaster08]

Bonjour,

Si j'ai bien compris ce que tu cherche a faire c'est A - intersection(A,B).
Ce qui mathématiquement revient à l'intersection de A et 1-B (où 1 represente le tout, donc ici l'ensemble des cellules)
Mes connaissances en VBA sont limitée mais s'il est possible de calculer 1-B sans boucle, tu as une réponse.

[joe.levrai]

Bonjour,

très amusant comme exercice !

j'ai une piste qui semble cependant souffrir de deux lacunes :

- les .formula sautent et on ne conserve que le .value, je n'ai pas réussi à contourner ceci sans utiliser une boucle
- j'ai testé peu de combinaisons pour être certain que tout est ok


mais, ce ne sont que des ajustements que ne te freineraient pas je pense ?

La fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function DesunionV2(PlagePrincipale As Range, PlageAnnexe As Range) As Range
Dim MemoirePlagePrincipale, MemoirePlageAnnexe  ' stocker les valeurs des périmètres
 
    ' on stocke les valeurs des deux plages
    MemoirePlagePrincipale = PlagePrincipale.Value
    MemoirePlageAnnexe = PlageAnnexe.Value
 
    ' on remplace les valeurs de l'union et l'intersection
    ' pour obtenir l'intersection composée de cellules non vides
    Application.Union(PlagePrincipale, PlageAnnexe).Value = ""
    Application.Intersect(PlagePrincipale, PlageAnnexe) = "toto"
 
    ' la Désunion = les cellules vides de l'union
    Set DesunionV2 = Application.Union(PlagePrincipale, PlageAnnexe).SpecialCells(xlCellTypeBlanks)
 
    ' on remet les valeurs
    PlagePrincipale.Value = MemoirePlagePrincipale
    PlageAnnexe.Value = MemoirePlageAnnexe
End Function

et l'appel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub TestDesunion()
Dim PlageA As Range
Dim PlageB As Range
Set PlageA = Range(Cells(1, 1), Cells(21, 2))
Set PlageB = Application.Union(Cells(6, 1), Cells(3, 2))
 
MsgBox DesunionV2(PlageA, PlageB).Address
 
End Sub

[pijaku]

Bonjour Jacques, le forum,

En utilisant la méthode SpecialCells et une feuille intermédiaire (existante ou ajoutée pour l'occasion), on arrive à des résultats.
A tester, bien évidemment.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Function Reduction_Range(PlageA As Range, PlageB As Range) As String
    'Ici il faudrait tester les Range, leur Intersect, s'ils sont <> Nothing, etc.
    With Sheets("Feuil2")
        .Range(PlageA.Address).ClearContents
        .Range(PlageB.Address) = "toto"
        Reduction_Range = .Range(PlageA.Address).SpecialCells(xlCellTypeBlanks).Address
    End With
End Function

[unparia]

Bonjour à vous deux (Franck et Joe)
Vous êtes astucieux tous les deux , mais :
- comme tu le dis, joe, tu as un problème avec les formules
- quid , Franck, si les plages à traiter (surtout la seconde) contiennent déjà des cellules vides ?

Allez --->> je vais vous montrer où j'en suis --->>
la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Function enlever_plage(A As Range, B As Range) As Range
  Dim letout As Range, partage As Range, Av, Af, Bv, Bf
  Set letout = Application.Union(A, B): Set partage = Application.Intersect(A, B)
  If Not partage Is Nothing Then
    Av = A.Value: Af = A.Formula:   Bv = B.Value: Bf = B.Formula
    letout.Value = "": partage.Value = "sesame ouvre-toi"
    Set enlever_plage = Intersect(letout.SpecialCells(xlCellTypeBlanks), A)
    A.Value = Av: A.Formula = Af: B.Value = Bv: B.Formula = Bf
  Else
    Set enlever_plage = A
  End If
  Set letout = Nothing: Set partage = Nothing
End Function

un exemple de son appel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Dim plageA As Range, plageB As Range, resul As Range
  ' la plage dont on veut enlever des cellules
  Set plageA = Union(Range("A1:A10"), Range("A11:A12"), Range("B3"), Range("D5"))
  ' la plage contenant les cellules à enlever de la plage A
  Set plageB = Union(Range("A8"), Range("A10"), Range("D11"))
  ' notre plage résultante
  Set resul = enlever_plage(plageA, plageB)
 
  ' juste pour voir, maintenant ===>>
  resul.Select
  MsgBox resul.Address

Je vais tâcher (après la siestita et si je le peux) d'améliorer encore un peu.
Amitiés à vous deux.
Jacques

[pijaku]

- quid , Franck, si les plages à traiter (surtout la seconde) contiennent déjà des cellules vides ?

Pour moi, peu importe puisque je travaille sur une autre feuille.
Je vide la plage A,
Je remplit la plage B,
Je ressort la plage qui est restée vide : A - B
Par contre, le résultat est un String car je travaille sur une autre feuille (existante ou ajoutée pour l'occasion).

[RyuAutodidacte]

Re,
j'ai trouvé l'idée super intéressante, et je me suis penché aussi sur intersect,
mais avec le manque de temps (pas ma fonction de faire du Excel au taf), et encore plein de chose à apprendre,
je n'ai rien pu sortir; donc j'ai fait une petite recherche et je suis tombé sur ça à voir :

le code (j'ai testé rapidement) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub test()
'Code de Renfield - Admin CodeS-SourceS - MVP Visual Basic
    Exclude([A1:C20, E5:F20], [A3, B6:B7,C10,E10,F15:F18]).Select
End Sub
 
Function Exclude(ByRef voA As Range, ByRef voB As Range) As Range
Dim oI As Range
Dim oU As Range
    If Not (Nothing Is voA Or Nothing Is voB) Then
        Set oI = Intersect(voA, voB)
        Set oU = Union(voA, voB)
        If Nothing Is oI Then
            Set Exclude = oU
        Else
            With oU
                .Validation.Delete
                .Validation.Add xlValidateInputOnly, xlValidAlertStop
                oI.Validation.Delete
                Set Exclude = .SpecialCells(xlCellTypeAllValidation)
            End With
        End If
    End If
End Function

Edit : Ajout de l'auteur

[joe.levrai]

La méthode consistant à remplir la plage de listes de validation a un problème .... si à l'origine il y avait déjà des listes de validation

[RyuAutodidacte]

maintenant que j'ai un peu plus de temps là j'ai pu voir la snippet + le code en direct :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub CommandButton3_Click()
   exclus([B3:D12], [A10:C19]).Select
   MsgBox exclus([B3:D12], [A10:C19]).Address
End Sub 
Private Function exclus(r1 As Range, r2 As Range) As Range
   ' code libre d'utilisation et/ou diffusion. Seule obligation : y ajouter la mention suivante :
   ' ******Auteur : ucfoutu*************
   Dim letout As Range, partage As Range
   Dim r1valeur As Variant, r1formula As Variant, r2valeur As Variant, r2formula As Variant
   Set letout = Application.Union(r1, r2)
   Set partage = Application.Intersect(r1, r2)
   If Not Nothing Is partage Then
       r1valeur = r1.Value: r1formula = r1.Formula
       r2valeur = r2.Value: r2formula = r2.Formula
       letout.Value = vbNullString
       partage.Value = "non vide"
       Set exclus = letout.SpecialCells(xlCellTypeBlanks)
       r1.Value = r1valeur: r1.Formula = r1formula
       r2.Value = r2valeur: r2.Formula = r2formula
   Else
       Set exclus = letout
   End If
   Set letout = Nothing
   Set partage = Nothing
End Function

il faudra pour moi que je revois l'ensemble du post afin d'analyser tout ça.
post intéressant mais il faudra que je comprenne les différences entres les différents codes

voilà

[NVCfrm]

J’avoue avoir lu de bout en bout la page 1 sans vraiment comprendre les tenants et les aboutissants de la chose.
Il faut dire que parfois au gré des contextes, le cerveau s'obstine à rester dans une vue figée

La méthode consistant à remplir la plage de listes de validation a un problème .... si à l'origine il y avait déjà des listes de validation

Cette remarque dessus qui va m'aider à comprendre le but du code.
C'est très astucieux.
Pour la remarque c'est vrai que le code doit prendre les précautions pour sauvegarder la validation existante avant d'appliquer une validation temporaire.
S'il y a quelqu'un comme moi qui n'avait pas compris le but du fil/code, le but est de générer une troisième plage qui dérive des contraintes posées.
Une plage c, une plage i et une plage r renvoyant c, sans les éléments communs aux deux. Me semble m'être livré à ce genre d'exercices avec des requêtes sql.

ucfutu, ce pseudo me dit quelque chose. J'ai dû tomber sur ses codes quelque part. Le point commun des deux pseudos reste le u.

[unparia]

restons si vous le voulez bien à nos moutons.
J'ai dit plus haut que j'allais chercher à simplifier un peu.
Voilà où j'en suis :
pour appeler :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim plageA As Range, plageB As Range, resul As Range
  ' la plage dont on veut enlever des cellules
  Set plageA = Union(Range("A1:A10"), Range("A11:A12"), Range("B3"), Range("D5"))
  ' la plage contenant les cellules à enlever de la plage A
  Set plageB = Union(Range("A8"), Range("A10"), Range("D11"))
  ' notre plage résultante
  Set resul = enlever_plage(plageA, plageB)
 
  ' juste pour voir, maintenant ===>>
  resul.Select

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Function enlever_plage(A As Range, B As Range) As Range
  Dim dejavide As Range
  Set B = Intersect(A, B)
  On Error Resume Next ' si pas de vides
  Set dejavide = A.SpecialCells(xlCellTypeBlanks)
  Avaleur = A.Value: AFormula = A.Formula
  dejavide.Value = "XXX"
  On Error GoTo 0
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Avaleur = A.Value: AFormula = A.Formula ''''' ligne mise plus haut, à la place adéquate
  B.ClearContents
  Set enlever_plage = A.SpecialCells(xlCellTypeConstants)
  On Error Resume Next 'si pas de formules)
    Set enlever_plage = Union(A.SpecialCells(xlCellTypeConstants), A.SpecialCells(xlCellTypeFormulas))
  On Error GoTo 0
  If Not dejavide Is Nothing Then dejavide.Value = ""
  A.Value = Avalue: A.Formula = AFormula
End Function

je ferai des tests demain matin pour déceler si rien ne m'a échappé (fatigué)
Bonne nuit.

EDIT j'ai déplacé une ligne de code, que j'avais mise à la mauvaise ligne

[unparia]

Bon
Mes tests de ce matin ne m'ont pas (ou encore pas ) permis de découvrir une erreur.
Si quelqu'un d'autre a "mis le doigt" sur une erreur qui aurait pu échapper à mon grattage, il pourra utilement le signaler.
Le seul problème restant à régler me parait dans ces conditions être le traitement des cellules contenant une validation.
Mes premières analyses me conduisent à conclure que, pour ces cellules particulières, je ne pourrais éviter une boucle.
Mais :
- seules ces cellules-là seront alors concernées
- elles peuvent être traitées (effacées, puis reconstituées) sans passer par les areas (et cela, je sais le faire)
Voilà qui devrait considérablement faciliter les choses pour le traitement de ces cellules-là.

Je m'y mettrai cet après-midi si personne d'autre n'a une idée meilleure

[pijaku]

Bonjour Jacques,

Je trouves que tu "tritures" un peu trop le "bouzin" dans ton code.
Si l'on part de ma première proposition, que l'on mixe avec ton idée de récupérer formules et valeurs des cellules :
1- on se moque des listes de validation, elles seront toujours présentes,
2- on n'est pas obligé de passer par une autre feuille,
3- pas besoin de se préoccuper des cellules éventuellement vides en A (on remplit toutes les cellules de A),
4- si cellules vides en B, pas grave non plus.

Teste ce code [ton code simplifié] :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Function enlever_plage(A As Range, B As Range) As Range
    Dim AValeur, AFormula
        Set B = Intersect(A, B)
        'Evite le bug sur B.ClearContents si B Is Nothing :
        If B Is Nothing Then Set enlever_plage = A: Exit Function
        AValeur = A.Value: AFormula = A.Formula
        A.Value = "XXX" 'ne provoque pas d'erreur si liste de validation (y compris avec message d'erreur de saisie)
        B.ClearContents
        Set enlever_plage = A.SpecialCells(xlCellTypeConstants)
        A.Value = AValeur 'remet les valeurs dans les cells de A, y compris si liste de validation, y compris les "vides"
        A.Formula = AFormula
End Function

Ou alors quelque chose m'échappe...

Pour aller plus loin, il serait peut-être intéressant (mais cela seul toi peux le savoir ) de créer une fonction avec un second paramètre de type Array :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Function enlever_plage(A As Range, B() As Range) As Range

EDIT : on peut même s'affranchir de AValeur...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Function enlever_plage(A As Range, B As Range) As Range
    Dim AFormula
        Set B = Intersect(A, B)
        If B Is Nothing Then Set enlever_plage = A: Exit Function
        AFormula = A.Formula
        A.Value = "XXX": B.ClearContents
        Set enlever_plage = A.SpecialCells(xlCellTypeConstants)
        A.Formula = AFormula
End Function