Discussion :

[will-1981]

Bonjour,

Je vous sollicite pour faire une macro afin de filtrer toute une liste de valeur suivant un critère et le tout sans doublon.
Admettons que je recherche le code produit Toto et tous les composants qui s'y rattache dans une liste où il y a plusieurs fois le même code composant.

Car actuellement avec ce code (Je récupère tous les codes à partir de l'emplacement cells(9,50) puis fais un filtre sans doublon et copie l'informations en cellule "A9", par contre j'ai de temps en temps 2 fois la même ligne en A9 alors que l'informations est identique, je ne comprends pas pourquoi enfin bon ce problème est secondaire.

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
 
i = 1
z = 9
derniereligne = Sheets("besoin").Range("A1").End(xlDown).Row
 
For i = 1 To derniereligne Step 1
 
    If Sheets("Besoin").Cells(i, 7) = Sheets("Composé -> composant").Range("B5") Then
 
        Sheets("Composé -> composant").Cells(z, 50) = Sheets("Besoin").Cells(i, 3)
        Sheets("Composé -> composant").Cells(z, 51) = Sheets("Besoin").Cells(i, 4)
        z = z + 1
    End If
Next
 
    Range("AX9:AY" & z & "").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A9"), Unique:=True

Pour informmation :
Sheets("Besoin").Cells(i, 7) = l'endroit où on retrouvera "Toto" dans la liste des composants
Sheets("Composé -> composant").Range("B5") = l'endroit où on renseigne le code "Toto"

Je souhaite réaliser un vrai code VB avec boucle d'interrogation... sans utiliser advancedfilter.

Merci pour votre aide.
Will

[mercatog]

Bonjour,
essaies cette gymnastique

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
Dim derniereligne As Long, i As Long, z As Long
Dim ws As Worksheet
Dim TabTemp() As Variant, Tablo As Variant
Dim cRow As New Collection
 
z = 9
Set ws = Sheets("Composé -> composant")
With Sheets("besoin")
    derniereligne = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 1 To derniereligne
        ReDim Preserve TabTemp(i)
        TabTemp(i - 1) = .Range("G" & i).Value & "£" & .Range("C" & i).Value & "£" & .Range("D" & i).Value
    Next i
 
    For i = 0 To UBound(TabTemp)
        Tablo = Split(TabTemp(i), "£")
        If ws.Range("B5") = Tablo(0) Then
            On Error Resume Next
            cRow.Add TabTemp(i), TabTemp(i)
        End If
    Next i
    For i = 1 To cRow.Count
        Tablo = Split(cRow(i), "£")
        ws.Range("AX" & z).Value = Tablo(1)
        ws.Range("AY" & z).Value = Tablo(2)
        z = z + 1
    Next i
 
End With

[will-1981]

Je te remercie pour ce code, mais ça ne fonctionne pas pour l'instant, il me m'est que erreur d'execution 9, l'indice n'appartient pas à la selection. Ca se passe au niveau de la 2ème boucle "For/Next"

Cdt,
will

[mercatog]

J'ai fais un classeur exemple pour tester et chez moi le code fonctionne.
si tu peux mettre en pièces joint un extrait de ton fichier (pour voir la disposition de tes données)

[will-1981]

Bonjour mercatog,
Désolé pour la réponse réponse tardive, mais quand le boulot te tiens, difficile de s'en défaire

Sinon moi aussi j'ai fais un classeur test je l'ai joints et ça ne fonctionne pas.

Merci pour ton aide
Ps : j'ai quelques modif. à la macro pour l'adapter à l'exemple.

[will-1981]

avec le fichier se sera mieux

[mercatog]

Bonsoir,
tes codes sont numériques
ci-joint changements sur le code(en commentaires)

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
Sub test()
 
Dim derniereligne As Long, i As Long, z As Long
Dim ws As Worksheet
Dim TabTemp() As Variant, Tablo As Variant
Dim cRow As New Collection
 
z = 9
Set ws = Sheets("Feuil1")
With Sheets("Feuil2")
    derniereligne = .Cells(.Rows.Count, 3).End(xlUp).Row   'Référence sur colonne C
    For i = 2 To derniereligne   'données commencent à la ligne 2
        ReDim Preserve TabTemp(i - 1)
        TabTemp(i - 2) = .Range("G" & i).Value & "£" & .Range("C" & i).Value & "£" & .Range("D" & i).Value
    Next i
 
    For i = 0 To UBound(TabTemp) - 1
        Tablo = Split(TabTemp(i), "£")
        If CStr(ws.Range("B5")) = Tablo(0) Then  'convertir la valeur de B5 en string
            On Error Resume Next
            cRow.Add TabTemp(i), TabTemp(i)
        End If
    Next i
   ws.Range("a" & z & ":b" & ws.cells(8,1).end(xldown).row).clearcontents 'effacer les données existantes
    For i = 1 To cRow.Count
        Tablo = Split(cRow(i), "£")
        ws.Range("a" & z).Value = Tablo(1)
        ws.Range("b" & z).Value = Tablo(2)
        z = z + 1
    Next i   
End With
Set ws=nothing 'Libérer ws
End Sub

[will-1981]

Yessssss

Merci Mercatog ça fonctionne super bien.

Par contre j'aimerais être moins bête, peux tu me dire ce que ça signifie :

Le £ (je pense à une concaténation)

En tout cas merci encore.
Will

[mercatog]

Bonjour,
en fait le £ est un caractère qui permettrait de séparer les données d"une ligne
exemple, pour une ligne xx
en Gxx: 2
en Cxx: aa
en Dxx: aaaaa
TabTemp(xx-2) aura comme valeur le string 2£aa£aaaaa
(le £ peut être remplacé par n'importe quel caractère que tu es sûr n'existe pas dans tes données, par exemple "µ"...)
(le xx-2 parce que les données commencent à 2 et TabTemp à 0)
on aura à la fin un tableau rempli TabTem (de 0 à derniereligne-2)
ensuite
pour chaque valeur TabTemp(j) on construit un autre tableau Tablo à l'aide de la fonction Split
cette fonction scinde le string contenu dans TabTemp(j) en parties séparées par le "£". on aura par exemple pour TabTemp(xx): Tablo(0)=2, Tablo(1)=aa et Tablo(2)=aaaaa
on compare alors Tablo(0) avec range(B5)...etc
le fait de faire cette gymnastique est de pouvoir obtenir une collection cRow (par nature sans doublons) de toutes les lignes dont la valeur en G = B5

il ne reste qu'à dispatcher le Tableau Split(cRow,"£")