XL 2016 Filtre Auto par "Contient un mot"

[achraf26]

Bonjour,
j'ai crée un tableau pour rechercher un mot "X" dans la colonne D, que je prefere est de filtrer par "Contient un mot", par Exemple dans le tableau si dans la case E4 "Nom" je note SA ça doit me donner 2 resultats : Sarah et Sandy.
ce tableau fonctionne correctement juste avec un mot exact.
Merci bcp

 

[Hieu]

Salut,
En ajoutant une étoile, au bout :

Option Explicit
Private Sub Worksheet_Change(ByVal c As Range)
    If c.Address = "$E$4" Then
        Select Case c
        Case "": ActiveSheet.ListObjects("TI").Range.AutoFilter Field:=3
        Case Else: ActiveSheet.ListObjects("TI").Range.AutoFilter Field:=3, Criteria1:=c & "*" 'ici !
        End Select
        [E4].Select
    End If
End Sub

 

[achraf26]

Merci Hieu pour votre message, ça fontionne bien, juste quand j'ai mis des chiffres : "1200" et "1500" ça fonctionne pas en faisant "1" ou "1200" le filtre est de 0

 

[Hieu]

Il faut forcer le format de ta colonne "d" en texte

 

[achraf26]

Merci Hieu, ça fonctionne, est ce que normal à chaque fois si je note un chiffre il va avoir une erreur en vert à la gauche de la case ?

 

[Hieu]

Oui, excel met un warning pour te dire que tu as un nombre sou forme de texte

 

[achraf26]

Oui, excel met un warning pour te dire que tu as un nombre sou forme de texte

c'est génant 🙁 je cherche encore solution pour que ca sera pas toujours affiché a chaque fois j'ecris un chiffre

 

[Hieu]

Tu mets une apostrophe avant. Normalement, ca marche.
Ex: '43

 

[Jacky67]

c'est génant 🙁 je cherche encore solution pour que ca sera pas toujours affiché a chaque fois j'ecris un chiffre

Bonjour,
Dans les options excel
Formules==> section==>Règles des vérifications des erreurs==>décocher
"Nombres mis en forme en tant que texte ou précédés d'une apostrophe"

 

[achraf26]

Mais pourquoi je trouverai pas une solution en vba que la recherche fonctionne en colonne meme en restant en format standard

 

[Hieu]

Salut,

Un test:

'Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Set wf = WorksheetFunction

If Not Intersect(Target, Range("$E$4")) Is Nothing Then
    If IsEmpty(Target) Then
    Rows("7:21").Hidden = False
    Exit Sub
    End If
    Rows("7:21").Hidden = True
    If Not IsNumeric(Target) Then
        For Each c In Range("d7:d21")
        If c Like Target & "*" Then Rows(c.Row).Hidden = False
        Next c
    Else
        nb_targ = Int(wf.Log10(Target))
        For Each c In Range("d7:d21")
        If IsNumeric(c) Then
            nb_c = Int(wf.Log10(c))
            If nb_c >= nb_targ Then
                temp = Int(c / 10 ^ (nb_c - nb_targ))
                If temp = Target Then Rows(c.Row).Hidden = False
            End If
        End If
        Next c
    End If
Range("e4").Select
End If
End Sub

 

[job75]

Bonjour achraf26, Hieu, Jacky67,

Le filtre avancé permet de faire plus de choses que le filtre automatique :

Private Sub Worksheet_Change(ByVal c As Range)
If c.Address <> "$E$4" Then Exit Sub
[E4].Select
[H7] = "=SEARCH(E$4,D7)" 'critère
ListObjects(1).Range.AdvancedFilter xlFilterInPlace, [H6:H7]
[H7] = ""
End Sub

Et mettez une police de couleur blanche en H7, c'est mieux.

A+

 

[Si...]

Bonsoir

une autre présentation : le filtre se produit dès la saisie dans le contrôle ajouté.

 

[job75]

Bonjour à tous,

Une recherche tous azimuts dans le fichier joint :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E3:E4]) Is Nothing Then Exit Sub
Dim a$, mem, j%, i&
[E4].Select
Application.ScreenUpdating = False
Application.EnableEvents = False
With ListObjects(1).Range
  If [E3] <> "" And [E3] <> Int(Val([E3])) Then [E3] = Int(Val([E3]))
  If [E3] <> "" And (Val([E3]) < 1 Or Val([E3]) > .Columns.Count) Then [E3] = ""
  If [E3] = "" Then a = .Rows(2).Address(0, 0) Else a = .Cells(2, [E3]).Address(0, 0)
  mem = .Formula 'mémorise
  For j = IIf([E3] = "", 1, [E3]) To IIf([E3] = "", .Columns.Count, [E3])
    For i = 2 To .Rows.Count
      .Cells(i, j) = "'" & .Cells(i, j).Text 'valeur affichée
  Next i, j
  .Cells(2, .Columns.Count + 2) = "=SUMPRODUCT(N(ISNUMBER(SEARCH(E$4," & a & "))))"
  .AdvancedFilter xlFilterInPlace, .Cells(1, .Columns.Count + 2).Resize(2)
  .Cells(2, .Columns.Count + 2) = ""
  For j = IIf([E3] = "", 1, [E3]) To IIf([E3] = "", .Columns.Count, [E3])
    For i = 2 To .Rows.Count
      .Cells(i, j) = mem(i, j) 'valeur initiale
  Next i, j
End With
Application.EnableEvents = True
End Sub

A+

 

[achraf26]

Bonjour à tous,

Une recherche tous azimuts dans le fichier joint :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E3:E4]) Is Nothing Then Exit Sub
Dim a$, mem, j%, i&
[E4].Select
Application.ScreenUpdating = False
Application.EnableEvents = False
With ListObjects(1).Range
  If [E3] <> "" And [E3] <> Int(Val([E3])) Then [E3] = Int(Val([E3]))
  If [E3] <> "" And (Val([E3]) < 1 Or Val([E3]) > .Columns.Count) Then [E3] = ""
  If [E3] = "" Then a = .Rows(2).Address(0, 0) Else a = .Cells(2, [E3]).Address(0, 0)
  mem = .Formula 'mémorise
  For j = IIf([E3] = "", 1, [E3]) To IIf([E3] = "", .Columns.Count, [E3])
    For i = 2 To .Rows.Count
      .Cells(i, j) = "'" & .Cells(i, j).Text 'valeur affichée
  Next i, j
  .Cells(2, .Columns.Count + 2) = "=SUMPRODUCT(N(ISNUMBER(SEARCH(E$4," & a & "))))"
  .AdvancedFilter xlFilterInPlace, .Cells(1, .Columns.Count + 2).Resize(2)
  .Cells(2, .Columns.Count + 2) = ""
  For j = IIf([E3] = "", 1, [E3]) To IIf([E3] = "", .Columns.Count, [E3])
    For i = 2 To .Rows.Count
      .Cells(i, j) = mem(i, j) 'valeur initiale
  Next i, j
End With
Application.EnableEvents = True
End Sub

A+

c'est intérssant pour une recherche Multiple Précise. merci