[VBA-E]Comment "conserver" une selection

Version imprimable

30/01/2007, 11h44
Annick.w

[VBA-E]Comment "conserver" une selection

Bonjour à tous,

Dans une boucle, quel est le code qui permet de conserver plusieurs lignes selectionner (ces lignes peuvent ne pas se suivre).
Afin de pouvoir "deleter" la selection après la boucle.

(je ne sais pas comment aller chercher cette info dans la FAQ ...)

Merci a tous pour votre aide

Bonjour , Annick.w

en utilisant "Union"

un petit morceau de code à adapter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Sub testA()
Dim zAParcourir As Range 'Zone à parcourir
Dim rL As Range 'ligne parcourue..
Dim zADetruire As Range 'Zone à effacer
 
Set zAParcourir = ThisWorkbook.Sheets(1).Range("A1").CurrentRegion
 
For Each rL In zAParcourir.Rows
If rL.Cells(1) = "X" Then 'par exemple s'il y as X dans 1° colonne...
  If zADetruire Is Nothing Then
     Set zADetruire = rL ' Pour la 1° ligne trouvée
  Else
    Set zADetruire = Union(zADetruire, rL) 'Rajoute une ligne
  End If
End If
Next
 
 zADetruire.Select 'Selectionne la zone pour montrer le resultat...
End Sub

pour effacer les lignes remplace .Select par .Delete (pas besoin de select..)

Bonjour bbil,
Je n'ai pas très bien compris ton code, peux tu regarder ce que j'ai fait.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub TITI() Range("a1").Select Do If ActiveCell.Value = "40100000" And ActiveCell.Value <= "40110000" Then ActiveCell.EntireRow.Delete ElseIf ActiveCell.Value >= 41100000 And ActiveCell.Value <= 41110000 Then ActiveCell.EntireRow.Delete ElseIf ActiveCell.Value = "42810000" Then ActiveCell.EntireRow.Delete ElseIf ActiveCell.Value = "48860000" Then ActiveCell.EntireRow.Delete ElseIf ActiveCell.Value = 48870000 Then ActiveCell.EntireRow.Delete End If ActiveCell.Offset(1, 0).Select Loop While ActiveCell.Value <> "" End Sub
:oops: Je ne sais pas inserer un code !!!!

Je dois supprimer les lignes qui commencent par ces N°, et là ou ça ne marche plus, c'est lorsque 2 lignes a supprimées se suivent. Lorsque la 1iere ligne est supprimèe, l'Offset est décalé et il saute la 2ième.
Je comprends ce qui cloche mais je n'arrive pas a le resoudre.

30/01/2007, 15h59
Annick.w

Ouskel'n'or,
Est ce que j'ai bien compris, tu me dis de remplacer la boucle do par une boucle for ?

J'ai essayé, mais rien ne se passe...

PS : J'ai supprimè les fourchettes.
30/01/2007, 16h03
SfJ5Rpw8

Annick.w,
pourrai tu nous préciser les conditions de "delete" de tes lignes...? une valeur dans colonne A..?
30/01/2007, 16h20
Annick.w

Oui, oui, bbil, ce sont des valeurs en colonne A .
30/01/2007, 17h01
SfJ5Rpw8

Citation:

Envoyé par Annick.w

Oui, oui, bbil, ce sont des valeurs en colonne A .

pourrai tu m'en dire plus.. j'ai du mal à déchiffrer ton code pour déterminer "la régle" qui permet de savoir en fonction de la valeur en A si l'on doit effacer ou pas la ligne..?
30/01/2007, 18h49
Annick.w

1 pièce(s) jointe(s)

Citation:

Envoyé par bbil

pourrai tu m'en dire plus.. j'ai du mal à déchiffrer ton code pour déterminer "la régle" qui permet de savoir en fonction de la valeur en A si l'on doit effacer ou pas la ligne..?

Pièce jointe 9165

bbil, je t'envoie le fichier, la macro "toto" a mis en jaune les lignes a suprimer et "tutu" a essayé de les supprimer....

Merci beaucoup pour ton aide bbil, c'est très sympa

Annick

bon voila un titi qui sélectionne:

Code:

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
26
27
28
29
 
Sub titiSelect()
Dim zAParcourir As Range 'Zone à parcourir
Dim rL As Range 'ligne parcourue..
Dim zADetruire As Range 'Zone à effacer
Set zAParcourir = ThisWorkbook.Sheets(1).Range("A1").CurrentRegion
For Each rL In zAParcourir.Rows
   If rL.Cells(1) >= "40100000" And rL.Cells(1) <= "40110000" _
    Or rL.Cells(1) >= "41100000" And rL.Cells(1) <= "41110000" _
    Or rL.Cells(1) = "42810000" _
    Or rL.Cells(1) = "48860000" _
    Or rL.Cells(1) = "48870000" Then
    Set zADetruire = AjouteRange(zADetruire, rL) 'Rajoute une ligne
  End If
Next
 zADetruire.Select 'Selectionne la zone pour montrer le resultat...
End Sub
 
Function AjouteRange(z1 As Range, z2 As Range) As Range
  If z1 Is Nothing Then
      Set AjouteRange = z2
      Exit Function
  End If
  If z2 Is Nothing Then
      Set AjouteRange = z1
      Exit Function
  End If
 Set AjouteRange = Union(z1, z2)
End Function

manque plus qu'as modifier la ligne

Code:

1
2
 
 zADetruire.Select 'Selectionne la zone pour montrer le resultat...

pour devenir un tutu ou un toto... :mouarf:

30/01/2007, 21h49
Annick.w

bbil,.........

Je suis vraiment nule......, je comprends rien....:arf:

Je n'arrive pas a faire marcher.........

dit....tu veux expliquer au :boulet:
30/01/2007, 21h56
SfJ5Rpw8
tu arrive à quoi ...? cela ne sélectionne pas ... en remplaçant ton toto ou tutu..?
tu as un message d'erreur ..? (le temps que tu me réponde je regarde avec ton fichier..)

[Edit] c'est bon même avec ton fichier ... tu remplace le code de ton module2 par celui que j'ai posté 2 posts plus haut.... tu exécute TitiSelect.. et puis tu observe les cellules sélectionnées...
pour rendre le test plus visuel tu peu modifier les derniéres lignes de titiSelect et y placer :
Code:

1 2 3 4 5 Next 'zADetruire.Select 'Selectionne la zone pour montrer le resultat... zADetruire.Interior.Color = vbRed End Sub
30/01/2007, 22h00
Annick.w

j'ai mis ton titi et j'ai enlevé mes toto et tutu et j'ai rien qui se passe.

Il faut dire que je n'ai pas très bien compris ....ce que je faisais.....

Je n'ai aucun message d'erreur
30/01/2007, 22h17
SfJ5Rpw8
oups entre-temps je viens d'editer (voir [Edit] mon message précédent..)

en fait dans la premiére partie du code .. (procedure titiSelect)

la ligne
Code:

1 2 Set zAParcourir = ThisWorkbook.Sheets(1).Range("A1").CurrentRegion
défini la zone à tester ... (place toi en A1 puis actionne CTRL * .. tu pour connaitre ta "CurrentRegion"

ensuite la boucle For Each ... parcours toutes les lignes de cette Zone ..

Code:

For Each rL In zAParcourir.Rows

à chaque tour de boucle rL représente une ligne de la Zone...

ensuite on j'applique ton test de valeur tel quel à la premiére cellule de la ligne (1° colonne) rl.Cells(1)...
et si la condition et vérifier j'applique la fonction AjouteRange... décrite plus loin...

une fois toute les lignes parcourues .. une action peu être appliquée à la zone résultante : zAdetruire...

La fonction AjouteRange prend en argument 2 zone et en renvoi l'UNION (voir :f1: ....

les deux premiers tests permettent si l'un des arguments de la fonction AjouteRange et nul de renvoyé l'autre argument ( c'est le cas lors du premier tour de boucle ou zADetruire et vide..)

sinon on renvoi l'UNION de ces 2 arguments....

bon voila .. j'espére que c'est plus clair... ;)
30/01/2007, 22h35
Annick.w

bbil, j'essaie de faire et je te dis

à tout à l'heure.

Annick
30/01/2007, 22h42
Annick.w

bbil,

Chez toi ça marche ?