Discussion :

[rico63]

Bonjour à tous,
Je vais tenter d'expliquer mon besoin ...

J'ai un fichier Excel qui comporte une dizaine de colonnes, j'applique sur la première ligne et l'ensemble des colonnes sélectionnées un filtre automatique.

Ensuite je viens appliquer un premier filtre sur la colonne 3 puis un second filtre sur la colonne 5.

J'obtiens ainsi un ensemble de données que je dois éclater dans différents onglets en fonction du fournisseur qui se trouve dans la colonne 1. Dans les données du filtre de la colonne 1 je vois les différents fournisseurs et uniquement ceux qui correspondent des deux premiers critères de sélection (pas la totalité des fournisseurs qui peuvent exister à l'origine du fichier est cela me convient parfaitement).
Comment faire une boucle en vba pour passer un par un les fournisseurs contenus dans la liste du filtre de la colonne 1 ?

Merci pour votre aide.

[zoom61]

Pourquoi ne pas au départ de ton code ne pas chercher le nombre de ligne du fichier, et après par ligne lancer ton code jusqu'à arriver à la dernière ligne.

[mayekeul]

bonjour,

un code dans le genre devrais t'y aider je pense

Code :

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

1
2
3
4
5
6
7
8
 
dim rng as range, c as range
 
set rng= range(cells(2,1),cells(1,1).end(xldown))
 
for each c in rng
    ...
next c

[rico63]

Merci pour ton code mayekeul mais il ne correspond pas totalement à ce que je souhaite faire.
D'après le test que je viens d'effectuer, la boucle prend toutes les lignes une par une et en ce qui me concerne, le même fournisseur peut apparaitre sur x lignes dans le fichier et je ne souhaite le filtrer qu'une seule fois !
C'est pour cela que je souhaite récupérer les informations contenues dans le filtre et les mémoriser dans une liste par exemple pour ensuite faire varier mon filtre avec la liste.
Enfin c'est une idée mais s'il y a mieux je prends aussi.
Merci.

[mayekeul]

alors on peux faire un truc du genre je pense

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
dim rng as range, c as range
dim c as range,koko as new collection
 
set rng= range(cells(2,1),cells(1,1).end(xldown))
 
on error resume next
for each c in rng
    koko.add c.value,c.text
next c
on error goto 0
'il ne reste plus qu'a itérer koko

[Didier Gonard]

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub soluce()
Dim objMaPlage As Range
Dim cell As Range
 
Set objMaPlage = Range(Range("A" & Rows.Count).End(xlUp), Cells(4, 1)).SpecialCells(xlCellTypeVisible)
'ligne de titres en ligne 4, attention le titre A4 est contenu dans le résultat.
objMaPlage.Select 'inutile, pour visualisation seulement
For Each cell In objMaPlage
 'Le code voulu
 Debug.Print cell.Address 'pour exemple
Next cell
Set objMaPlage = Nothing 'pas obligatoire, mais bonne habitude.
End Sub

cordialement,

Didier

[rico63]

Bonsoir,

1) le nouveau code proposé par mayekeul ne supprime pas les doublons d'après mes tests mais je peux me tromper.
2) Merci Ormonth pour ta proposition, je vais essayer demain. Il ne faut pas que j'ai de doublons, ton code tient t-il compte de ce besoin ?

3) Voici ma solution : vous pouvez la commenter et me faire des propositions d'amélioration sur le code. Merci.

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub CréationListeFournisseur()
 
Dim Feuille As Worksheet, Rng As Range
Set Feuille = ThisWorkbook.Sheets("Les données SAP")
Set Rng = Feuille.Cells(1, 1)
 
Dim Fournisseur As Collection
Set Fournisseur = New Collection
 
' Début de la recherche de la dernière valeur sur la colonne 2 soit la lettre B
    Sheets("Les données SAP").Select
    Set Feuille = ThisWorkbook.Sheets("Les données SAP")
    Set Rng = Feuille.Cells(65536, 2)
 
    Do While IsEmpty(Rng) And Rng.Row > 1
    Set Rng = Rng.Offset(-1)
    Loop
        If IsEmpty(Rng) Then
        lastline = 0
        Else
        lastline = Rng.Row
        End If
'Fin de la recherche de la dernière valeur dans la colonne 2 soit la lettre B
'-------------------------------------------------------------------
 
'Début des opérations pour lister les noms des fournisseurs sans doublons
For compteur = 6 To lastline
  If Range("B" & compteur) <> Range("B" & compteur - 1) Then
      Fournisseur.Add Range("B" & compteur)
  Else
  End If
Next compteur
'Fin des opérations pour lister les noms des fournisseurs sans doublons
'--------------------------------------------------------------------------
 
'Début de la boucle pour faire varier le filtre
For compteur = 1 To Fournisseur.Count
Selection.AutoFilter Field:=2, Criteria1:=Fournisseur(compteur)
Next compteur
'Fin des opérations pour lister les noms des fournisseurs sans doublons
'--------------------------------------------------------------------------
 
End Sub

[Didier Gonard]

J'obtiens ainsi un ensemble de données que je dois éclater dans différents onglets en fonction du fournisseur qui se trouve dans la colonne 1. Dans les données du filtre de la colonne 1 je vois les différents fournisseurs et uniquement ceux qui correspondent des deux premiers critères de sélection (pas la totalité des fournisseurs qui peuvent exister à l'origine du fichier est cela me convient parfaitement).
Comment faire une boucle en vba pour passer un par un les fournisseurs contenus dans la liste du filtre de la colonne 1 ?

Merci pour votre aide.

Dans la liste demandée, tu risques d'avoir des doublons fournisseurs ? et li faut alors les éliminer ?

cordialement,

Didier

[rico63]

Bonsoir Didier,

Oui je peux avoir des doublons ''Fournisseur'' dans la colonne B car plusieurs lignes aves différentes informations ont le même fournisseur.

Non je ne souhaite pas supprimer les doublons dans le fichier Excel mais oui je souhaite avoir une liste sans doublons pour gérer ma boucle ensuite.

Cordialement.

P.S : j'ai commis une erreur dans la première description de mon besoin, les fournisseurs sont bien dans la colonne 2.

[Didier Gonard]

à adapter à ton cas...

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 soluce()
Dim objMaPlage As Range
Dim cell As Range
Dim colCollectionPass As Collection
Dim I As Long
 
Set objMaPlage = Range(Range("A" & Rows.Count).End(xlUp), Cells(4, 1)).SpecialCells(xlCellTypeVisible)
objMaPlage.Select 'inutile, pour visualisation seulement
Set colCollectionPass = New Collection
 On Error Resume Next
For Each cell In objMaPlage
   colCollectionPass.Add cell, CStr(cell)
Next cell
For I = 2 To colCollectionPass.Count 'on élimine le titre en 1...ce qui serait plus lour avec un for each
   Debug.Print colCollectionPass(I) 'résultat voulu à employer sous la forme désirée.
Next I
 
Set objMaPlage = Nothing 'pas obligatoire, mais bonne habitude.
Set colCollectionPass = Nothing
End Sub

cordialement,

Didier

[rico63]

Bonjour,

Désolé pour ma réponse aussi tardive mais ces 3 derniers jours, que des problèmes à régler en urgence à longueur de journée. Vive les vacances et le manque de personnel.

Merci Didier pour ta nouvelle proposition, le résultat me convient, je vais finaliser quelques modifications et je pense que le résultat sera là ...

Encore Merci à tous pour votre aide.
@+ et bon week-end.