[VBA-E]Comment "conserver" une selection

**Annick.w** · 30/01/2007, 11h44

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

**SfJ5Rpw8** · 30/01/2007, 12h12

Bonjour , Annick.w

en utilisant "Union"

un petit morceau de code à adapter

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
 
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..)

**Annick.w** · 30/01/2007, 15h29

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

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
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

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.

**Annick.w** · 30/01/2007, 15h59

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.

**SfJ5Rpw8** · 30/01/2007, 16h03

Annick.w,
pourrai tu nous préciser les conditions de "delete" de tes lignes...? une valeur dans colonne A..?

**Annick.w** · 30/01/2007, 16h20

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

**SfJ5Rpw8** · 30/01/2007, 17h01

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..?

**Annick.w** · 30/01/2007, 18h49

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..?

gene.zip

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

**SfJ5Rpw8** · 30/01/2007, 21h27

bon voila un titi qui sélectionne:

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
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 :

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

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

pour devenir un tutu ou un toto...

**Annick.w** · 30/01/2007, 21h49

bbil,.........

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

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

dit....tu veux expliquer au

**SfJ5Rpw8** · 30/01/2007, 21h56

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 :

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

1
2
3
4
5
 
Next
 'zADetruire.Select 'Selectionne la zone pour montrer le resultat...
 zADetruire.Interior.Color = vbRed
End Sub

**Annick.w** · 30/01/2007, 22h00

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

**SfJ5Rpw8** · 30/01/2007, 22h17

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 :

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

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 :

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

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

....

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...

**Annick.w** · 30/01/2007, 22h35

bbil, j'essaie de faire et je te dis

à tout à l'heure.

Annick

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

bbil,

Chez toi ça marche ?

[VBA-E]Comment "conserver" une selection

Macros et VBA Excel

Discussions similaires

Partager

Partager