Filtre élaboré + Formule

Version imprimable

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

Merci d'avance.

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

06/12/2011, 09h56
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
07/12/2011, 08h03
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

;)

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.

07/12/2011, 14h02
jfontaine

Citation:

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

Avec quel code??
08/12/2011, 00h25
apt

Bonsoir gFZT82,

Citation:

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
08/12/2011, 00h32
apt

Bonsoir Jérôme,

Citation:

Envoyé par jfontaine

Avec quel code??

pour vos deux codes en premiere réponse :lol:

Bonjour,

Citation:

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.

09/12/2011, 00h26
apt

Salut gFZT82,

Ca marche.

Merci.

Cordialement.