Filtre VBA avec une variable non-complète

Version imprimable

Bonjour à tous,

dans le code ci-dessous, je voudrais filtrer une colonne par la variable ART. J'y arrive partiellement dans 2 cas sur 3 possible.

La même chaine de carractères (ex: 6300) saisie dans l'imput box peut apparaitre sous trois formes différentes:
a- 6300
b- nombre(6300)
c- 6300(nombre)
Les parenthèses sont toujours présentes seul le nombre change.

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
Private Sub CommandButton22_Click()
Dim ART As String
 
Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.ShowAllData
 
ART = InputBox("Saisir le numéro d'article avec * s'il faut")
 
 
If ART <> "" Then ActiveSheet.Range("$A$6:$AP$5000").AutoFilter Field:=2, Criteria1:=ART _
        , Operator:=xlOr, Criteria2:="=*(" & ART & ")"
 
 
 
'Tri commande VAI croissant et tri of croissant
ActiveWorkbook.Worksheets("Données").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Données").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("G6:G3618"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Données").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Données").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Données").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("E6:E3618"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Données").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
Application.ScreenUpdating = True
Application.Goto Range("A1"), True
 
End Sub

07/09/2023, 17h30
Dinytro

Possible de nous donner le fichier ?
J'avoue que je ne saisie pas trop le soucis...
14/09/2023, 18h53
alexis trotta

Bonjour Dinytro

voici un exemple des données présentes dans la colonne que je voudrait trier.

2870
6206(6117)
827
945
945
222(185)
6247
6245
6246
6242
6237
6228
70

1 pièce(s) jointe(s)

Bonjour
Dans le cas ou vous avez une base de données plein de code articles et tu ne connais que une partie du code un ami de ce super site a développer quelques chose très pertinent au moins pour moi :):)
Je ne souviens plus du nom mais certainement je passe un grand merci à ce monsieur
Conception des données : Une colonne pour le code et une colonne pour la désignation et tu ajoute une troisième colonne concaténée pour chercher avec une partie du code article et une partie du désignation et dans ce cas tu utilise un étoile entre les deux parties saisies (*)
voila 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
Private O As Worksheet 'déclare la variable O (Onglet)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
 
Private Sub CommandButton1_Click()
Unload Me
End Sub
 
Private Sub UserForm_Initialize()
Set O = Sheets("Feuil1") 'définit l'onglet O
TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC
Me.ListBox1.ColumnCount = 2 'définit le nombre de colonnes de la ListBox1
UserForm2.ListBox1.ColumnWidths = "100;435"
End Sub
 
Private Sub TextBox1_Change() 'au changement dans la TextBox1
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
 
Me.ListBox1.Clear 'vide la ListBox1
If Me.TextBox1.Value = "" Then Exit Sub 'si la Textbox1 est vide (effacée), sort de la procédure
K = 1 'initialise la variable K
For I = 2 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellules TC (en partant de la seconde)
    For J = 1 To UBound(TC, 2) 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
        'condition : si la valeur ligne I colonne J de TC contient le texte de la Textbox1
        If UCase(TC(I, J)) Like "*" & UCase(Me.TextBox1.Value) & "*" Then
            ReDim Preserve TL(1 To UBound(TC, 2) + 1, 1 To K) 'redimensionne le tableau de lignes TL (autant de lignes que TC a de colonne plus une, K colonnes)
            'TL(1, K) = I 'récupère dans la ligne 1 de TL le numéro de ligne I (cette donnée sera masquée après transposition)
            For L = 2 To UBound(TC, 2) + 1 'boucle 3 : sur les lignes 2 à nombre de colonnes de TC plus une, de TL
                TL(L - 1, K) = TC(I, L - 1) 'récupere dans la ligne de TL, la valeur de la colonne de TC (=> transposition)
            Next L 'prochaine ligne de la boucle 3
            K = K + 1 'incrément K (=> ajoute une colonne à TL)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'procjaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
If K = 1 Then Exit Sub 'si K est égale à un (=> aucune occurrence vérifiant la condition), sort de la procédure
If K = 2 Then ReDim Preserve TL(1 To UBound(TL, 1), 1 To 2) 'si K=2 (=> une seule occurrence), erdimensionne TL pour permettre la transposition
Me.ListBox1.List = Application.Transpose(TL) 'alimente la ListBox1 avec le trableau TL transposé (le numéro de ligne en colonne 1 est masqué)
End Sub

15/09/2023, 11h58
alexis trotta

Bonjour Bennars,

merci pour aide.

Je ne cherche pas à remonter des données d'une base, je veux juste filtrer mon tableau par la colonne contenant une liste d'articles dont j'ai posté un extrait représentatif.
Les données du tableau sont extraites d'une base Oracle et remise à jourquotidiennement.

1 pièce(s) jointe(s)

teste ça :
Ajoute une colonne avec la formule suivante : =TEXTE(A2;"00000")
Puis le filtre textuel sur cette nouvelle colonne "contient" fonctionne
avec VBA

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Test()
Dim F As Worksheet
Dim Lig As Long
Dim ART
Application.ScreenUpdating = False
Set F = Sheets("feuil1")
If F.FilterMode = True Then F.ShowAllData
Lig = F.Range("A" & Rows.Count).End(xlUp).Row
ART = InputBox("Saisir le numéro d'article ")
    F.Range("B2").FormulaR1C1 = "=TEXT(RC[-1],""00000"")"
    F.Range("B2").AutoFill Destination:=Range("B2:B" & Lig), Type:=xlFillDefault
    F.Range("$A$1:B" & Lig).AutoFilter Field:=2, Criteria1:="=*" & ART & "*", _
        Operator:=xlAnd
Application.ScreenUpdating = True
End Sub

18/09/2023, 12h31
alexis trotta

Merci Bennasr, mon problème est résolu.
Comme je ne pouvais pas intercaler une colonne, j'ai converti la colonne A en texte dans le VBA et j'ai modifier la plage du filtre.