Sélection multiple de cellules selon un critère

Version imprimable

06/01/2011, 13h50
arisToT

Sélection multiple de cellules selon un critère

Bonjour,
je voudrai pouvoir sélectionner automatiquement un ensemble de cellules qui ont la même valeur (par exemple la valeur 1). Je travaille avec des feuilles qui ont un grand nombre de lignes et de colonnes.
Pouvez-vous m'aider en me proposant une macro qui convient ?
Merci !
06/01/2011, 13h58
wilfried_42

Bonjour,

avec un exemple ca aurait été mieux, as tu regardé les filtres ? si ça te convient on poura les faires en Macro
06/01/2011, 14h22
arisToT

Pour un exemple c'est assez simple, imagine une feuille excel avec plein de cases remplies avec des mots. Je cherche à sélectionner d'un coup toutes les cases qui ont le mot "bidule".

C'est un peu le même esprit que la mise en forme conditionnelle (pour colorier en bleu toutes les cases qui ont une certaines valeur), sauf que là je ne veux pas les colorier mes juste les sélectionner (en fait ensuite je veux toutes les supprimer d'un coup avec décallage vers la gauche, mais c'est du détail).

Je ne suis pas sur que les filtres conviennent pour ça. Tu crois ?

Bonsoir à tou(te)s, arisToT,
tu peux adapter ce code à tes besoins mais si tu as vraiment beaucoup de ligne, ça risque d'etre long

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Macro1()
Dim cls As Range, x As Long, cel As Range, nblg As Long, nbcol As Long, plage As Range, trouve As String
With Sheets("feuil1")
   nblg = .Range("a" & .Rows.Count).End(xlUp).Row
   nbcol = .Range("IV4").End(xlToLeft).Column
   For x = 1 To nbcol
      Set plage = .Range(.Cells(1, x), .Cells(nblg, x))
      For Each cel In plage
         Set cls = plage.Find("bidule")
         If Not cls Is Nothing Then
            Set plage = .Range(.Cells(cls.Row + 1, x), .Cells(nblg, x))
            If trouve = "" Then
               trouve = cls.Address
            Else
               trouve = trouve & "," & cls.Address
            End If
         End If
      Next cel
   Next x
  .Range(trouve).Select
End With
End Sub

Bonne soirée

07/01/2011, 11h02
arisToT

Merci casefayere !
Je sens qu'on se rapproche...
malheureusement l'éxécution fait une erreur 1004 "définie par l'application ou par l'objet", et le débogage surligne vers la fin la ligne

Code:

Range(trouve).Select

Ca ne doit pas être grand chose, mais du coup je suis -encore :roll:- bloqué...
Merci de votre aide.
07/01/2011, 11h31
casefayere

Bonjour,
peux-tu mettre ton code complet, car j'ai testé et il n'y avait pas de problème.

A +

fais un msgbox à l'endroit en rouge et donnes-moi le résultat :
Code:

1 2 3 4 5 6 7 .... End If End If Next cel Next x msgbox trouve .Range(trouve).Select End With.......

07/01/2011, 11h51
arisToT

J'obtiens un grand message :
$E$5,$E$7,$E$11 ....... etc jusqu'à $Q$18
07/01/2011, 11h54
casefayere

alors, pas de probleme à ce niveau , copie et colle ton code sur un nouveau message, que je regarde de plus près

Je cherche à sélectionner toutes les cases "niet" dans une feuille qui s'appelle "e".

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub SelectNiet()
Dim cls As Range, x As Long, cel As Range, nblg As Long, nbcol As Long, plage As Range, trouve As String
With Sheets("e")
   nblg = .Range("a" & .Rows.Count).End(xlUp).Row
   nbcol = .Range("IV4").End(xlToLeft).Column
   For x = 1 To nbcol
      Set plage = .Range(.Cells(1, x), .Cells(nblg, x))
      For Each cel In plage
         Set cls = plage.Find("niet")
         If Not cls Is Nothing Then
            Set plage = .Range(.Cells(cls.Row + 1, x), .Cells(nblg, x))
            If trouve = "" Then
               trouve = cls.Address
            Else
               trouve = trouve & "," & cls.Address
            End If
         End If
      Next cel
   Next x
  .Range(trouve).Select
End With
End Sub

07/01/2011, 12h03
casefayere

je viens de réessayer sans problème, peux-tu faire une image de ta feuille et l'envoyer ?
07/01/2011, 12h50
arisToT

1 pièce(s) jointe(s)

Voilà à quoi ressemble ma feuille.
Pièce jointe 71404

Bonjour à tout le monde,

arisToT, j'ai modifié ton code, regarde si cela convient (commentaires dans le code) :

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Sub SelectNiet()
 
    Dim cls As Range, Adr As String, Plage As Range, trouve As String
 
    With Sheets("e")
 
        'défini la plage de recherche comme étant toute la zone utilisée
        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))
 
        'commence la recherhe
        Set cls = Plage.Find("niet", , xlValues)
 
        'si trouvée
        If Not cls Is Nothing Then
 
        'mémorise l'adresse de la première cellule
            Adr = cls.Address
 
        'puis boucle dans la plage à la recherche d'autre occurences
        'et mémorise leurs adresses
            Do
 
                trouve = trouve & "," & cls.Address
                Set cls = Plage.FindNext(cls)
 
            Loop While Adr <> cls.Address
 
        End If
 
        If trouve <> "" Then
 
        'épure les virgules extrêmes
            trouve = Mid(trouve, 2, Len(trouve) - 1)
            .Range(trouve).Select
 
        Else
 
            MsgBox "aucune occurence !"
 
        End If
 
    End With
 
End Sub

Hervé.

ok, je regarde en commençant par la bonne plage, je regardes le code en ce moment, encore un petit défaut mais ca fonctionne

j'en suis là :

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
Sub SelectNiet()
Dim cls As Range, x As Long, y As Long, cel As Range, nblg As Long, nbcol As Long, plage As Range, trouve As String
Dim col As String
With Sheets("e")
   y = 2
   nbcol = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
   For x = 1 To nbcol
      col = Split(.Cells(1, x).Address, "$")(1)
      nblg = .Range(col & .Rows.Count).End(xlUp).Row
      Set plage = .Range(.Cells(y, x), .Cells(nblg, x))
      y = y + 1
      For Each cel In plage
         Set cls = plage.Find("niet")
         If Not cls Is Nothing Then
            Set plage = .Range(.Cells(cel.Row + 1, x), .Cells(nblg, x))
            If trouve = "" Then
               trouve = cls.Address
            Else
               trouve = trouve & "," & cls.Address
            End If
         End If
      Next cel
   Next x
  .Range(trouve).Select
End With
End Sub

tu peux toujours essayer, encore une chose me géne si tu fais un

Code:

msgbox trouve

, des cellules se répète mais à la fin j'ai le résultat escompté

07/01/2011, 13h43
arisToT

2 pièce(s) jointe(s)

Je dois être un peu neuneu, mais avec vos deux codes, j'ai la même erreur sur la ligne

Code:

.Range(trouve).Select

Je vous mets les images :
Pièce jointe 71413
Pièce jointe 71415
07/01/2011, 13h45
Theze

Re

A la vue de ta feuille, il faut savoir que le buffer ne peut accepter qu'environ 255 caractères (si je ne me trompe pas) donc pour supprimer les "$" inutiles écris "Address" de cette façon :
trouve = trouve & "," & cls.Address(0, 0)
ce qui augmentera la capacité de cellules sélectionnables sans erreur sinon, scinder "trouve" et voir avec une union de zone (pas testé)

Hervé.

Re

Voir du coté de "Application.Union('Une partie de trouve','l'autre partie de trouve').Select"

Je n'ai pas testé, je doit partir maintenant mais je regarderais en rentrant ce soir si tu n'as toujours pas résolu ton problème.

Hervé.
07/01/2011, 13h56
arisToT

Effectivement ça doit être un problème de taille de feuille ou de contenu des cellules (certaines cellules peuvent avoir une centaine de caractères ou même plus), parce qu'en essayant sur une feuille de test ça marche très bien !
Comment faire ? :calim2:
Merci.

Citation:

Envoyé par arisToT

je veux juste les sélectionner (en fait ensuite je veux toutes les supprimer d'un coup avec décallage vers la gauche, mais c'est du détail).

Bonjour,

Pour réaliser cela, il n'est pas nécessaire de sélectionner les cellules
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub test_fring() Dim C As Range, Motatrouver As String Application.ScreenUpdating = False Motatrouver = "bidouille" Do Set C = Sheets(1).UsedRange.Find(Motatrouver, LookIn:=xlValues) If Not C Is Nothing Then C.Delete Shift:=xlToLeft Loop While Not C Is Nothing Application.ScreenUpdating = True End Sub

Bonjour fring, re le forum, Theze, arisToT
Avec son select, j'avais enfin trouvé la solution que je vais mettre mais je viens de regarder et tester ton code, aucun problème, d'autant que tu n'es pas obligé de passer par un string qui risque de poser des problèmes de longueur

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
30
31
Sub SelectNiet()
Dim cls As Range, x As Long, y As Long, cel As Range, nblg As Long, nbcol As Long, plage As Range, trouve As String
Dim col As String
With Sheets("e")
   y = 1
   nbcol = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
   For x = 1 To nbcol
      col = Split(.Cells(1, x).Address, "$")(1)
      nblg = .Range(col & .Rows.Count).End(xlUp).Row
      Set plage = Range(col & nblg, Range(col & nblg).End(xlUp))
      For Each cel In plage
         If .Cells(y + 1, x) <> "niet" And y < nblg Then
            y = y + 1
         End If
         Set plage = .Range(.Cells(y, x), .Cells(nblg, x))
         'Set cls = Nothing
         Set cls = plage.Find("niet", .Cells(y, x), , , xlByColumns)
         If Not cls Is Nothing Then
            If trouve = "" Then
               trouve = cls.Address
            Else
               trouve = trouve & "," & cls.Address
            End If
            y = cls.Row
         End If
      Next cel
      y = 1
   Next x
   .Range(trouve).Select
End With
End Sub

Bonne soirée à tou(te)s

10/01/2011, 09h24
arisToT

C'est super les gars, vous êtes des chefs !
Merci vraiment ! :ccool: