[XL-2007] Filtre élaboré + Formule [Résolu]

[apt]

Bonjour à tous,

J'aimerais filtré les données en colonne A, dans la colonne E et cela selon la formule :

Code :

=GAUCHE($A2;4)="T100"

en C1:C2

Code :

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Count = 1 Then
        [A1:A5000].AdvancedFilter Action:=xlFilterCopy, Criteriarange:=[C1:C2], CopyToRange:=[E1], Unique:=True
 
        [E16:E100].Sort Key1:=[E2]
    End If
End Sub

Mais je n'arrive toujours pas

Merci d'avance.

[jfontaine]

Bonjour,

Pas sur d'avoir bien compris.

Le code ci dessous copie toutes les occurrences de la colonne A dans la E si celles ci commence par "T100"

Code :

1
2
3
4
5
6
7
8
9
10
11
Dim i As Long
 
'Efface le précédent filtrage
Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).ClearContents
 
'Filtres les données
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If Left(Range("A" & i).Value, 4) = "T100" Then
        Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1).Value = Range("A" & i).Value
    End If
Next i

[gFZT82]

Bonjour,

J’obtiens le résultat avec le filtre élaboré suivant :
Copier vers un autre emplacement
Plages : $A$1:$A$5000
Zone de critères : $C$1:$C$2
Copier dans : $E$1
Extraction sans doublon

En A1, C1 et E1 les en-têtes.
En C2 la formule

Code :

="T100*"

L’enregistreur de macro indique

Code :

1
2
Range("A1:A5000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "C1:C2"), CopyToRange:=Range("E1"), Unique:=True

Cordialement

[apt]

Bonjour Jérôme, gFZT82

Je n'obtiens que les "T100-*", or j'aimerais obtenir tout les 4 caractères de la plage (A1:A5000)

Colonne A

T100-2
T101-12
T102-5
T100-14
T101-1
T101-11
T221-4

Colonne E

T100
T101
T102
T221

[gFZT82]

Bonjour,

Essaie avec ce 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
Option Explicit
Sub Liste_SansDoublons()
Dim DerLig As Long
Dim Plage As Range
Dim Cell As Range
Dim Un As Collection
Dim i As Long
    With Worksheets("Feuil1") 'A adapter
        DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Plage = .Range("A2:A" & DerLig)
        Set Un = New Collection
        On Error Resume Next
        'Boucle sur la plage
        For Each Cell In Plage
            ' Ajoute le contenu de la cellule dans la collection
            If Cell <> "" Then Un.Add Left(Cell, 4), Left(CStr(Cell), 4)
        Next Cell
        On Error GoTo 0
        'Efface le précédent filtrage
        .Range("E2:E" & .Range("E" & .Rows.Count).End(xlUp).Row).ClearContents
        'Boucle sur les éléments de la collection.
        For i = 1 To Un.Count
            'Ecrit le résultat dans la colonne E
            .Range("E" & i + 1) = Un.Item(i)
        Next i
    End With
    Set Un = Nothing
    Set Plage = Nothing
End Sub

Cordialement.

[jfontaine]

Je n'obtiens que les "T100-*", or j'aimerais obtenir tout les 4 caractères de la plage (A1:A5000)

Avec quel code??

[apt]

Bonsoir gFZT82,

Envoyé par gFZT82

Bonjour,
Essaie avec ce code

Ca marche très bien.

Mais, est-ce la Collection peut fonctionner pour deux colonnes A et B ?

Comme ce post ICI

[apt]

Bonsoir Jérôme,

Envoyé par jfontaine

Avec quel code??

pour vos deux codes en premiere réponse

[gFZT82]

Bonjour,

Mais, est-ce la Collection peut fonctionner pour deux colonnes A et B ?

Indirectement, oui.
Si j’ai bien compris, tu souhaites associer le nom à la référence.
Pour cela, dans la collection, il suffit de mémoriser l’adresse de la cellule correspondant à la référence (et non plus le contenu de la cellule).
Connaissant cette adresse, il est facile d’aller rechercher le contenu de la cellule en colonne A (référence) et celui de la cellule adjacente (nom).

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
Option Explicit
Sub Liste_SansDoublons()
Dim DerLig As Long
Dim Plage As Range
Dim Cell As Range
Dim Un As Collection
Dim i As Long
    With Worksheets("Feuil1") 'A adapter
        DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Plage = .Range("A2:A" & DerLig)
        Set Un = New Collection
        On Error Resume Next
        'Boucle sur la plage
        For Each Cell In Plage
            If Cell <> "" Then
                'Si la cellule n'est pas vide, on mémorise l'adresse de la cellule
                Un.Add Cell.Address, Left(CStr(Cell), 4)
            End If
        Next Cell
        On Error GoTo 0
        'Efface le précédent filtrage
        .Range("E2:E" & .Range("E" & .Rows.Count).End(xlUp).Row).ClearContents
        'Boucle sur les éléments de la collection.
        For i = 1 To Un.Count
            'Ecrit la référence dans la colonne E
            .Range("E" & i + 1) = Left(Range(Un.Item(i)), 4)
            'Ecrit le nom dans la colonne F
            .Range("E" & i + 1).Offset(0, 1) = Range(Un.Item(i)).Offset(0, 1)
            Next i
    End With
    Set Un = Nothing
    Set Plage = Nothing
End Sub

Cordialement.

[apt]

Salut gFZT82,

Ca marche.

Merci.

Cordialement.