problème filtrage et tri dans userform

[osiris150]

Bonjour à tous,

J'ai récupéré sur le forum ici : https://www.excel-downloads.com/threads/filtrage-colonne-valeur-listview.120368/ une méthode de recherche et tri dans un userform qui est super pratique et que j'ai adapté à mes besoins. Par contre j'ai un souci c'est que lorsque je renseigne les 2 critères de sélection pour faire ma recherche, le résultat ne s'affiche pas correctement. C'est à dire qu'en fait rien ne se passe. Pourtant il me semble avoir repris le code correctement. Mais j'ai sûrement oublier quelque chose.

Si quelqu'un pouvait m'aider ce serait très sympa.

Merci d'avance.
Ci-joint le fichier
Nicolas

 

[fhoest]

Re : problème filtrage et tri dans userform

Bonjour,
Oublie de declaration de variable en public dans un module (insertion modules)tu place ce code:

Public sel As String
Public col As Long
Public flag As Boolean

et voila le tour et jouer!!
A bientot.

 

[osiris150]

Re : problème filtrage et tri dans userform

Impec ça marche !! Merci fhoest

 

[osiris150]

Re : problème filtrage et tri dans userform

Je me permets de revenir pour savoir s'il serait possible d'améliorer la recherche en ayant la possibilité de la faire avec soit les 2 critères comme ceux qui existent ou alors avec la possibilité de faire une recherche avec seulement une partie de mot ? Il faudra créer un 3ème critère de sélection mais indépendant des 2 premiers. J'espère que mon explication n'est pas trop brouillon.

Merci d'avance
Ci-joint le fichier

 

[fhoest]

Re : problème filtrage et tri dans userform

Bonsoir,
Ajoute ceci

' ajouter un bouton de commande dans userform selection
'mettre option compare text en haut de chaque userform pour syntaxe like
Private Sub CommandButton1_Click()
Sheets("Base").AutoFilterMode = False
Dim efface As Boolean
efface = True



Dim cel As Range
mot = InputBox("entrer le mot a chercher")
For y = 1 To resultatbase.ListView1.ColumnHeaders.Count
For x = 1 To resultatbase.ListView1.ListItems.Count

On Error Resume Next
If resultatbase.ListView1.ListItems(x).ListSubItems(y) Like ("*" & mot & "*") Then
sel = resultatbase.ListView1.ListItems(x).ListSubItems(y)
col = y + 3
With Sheets("Base")
If efface = True Then
resultatbase.ListView1.ListItems.Clear
efface = False
End If
    .AutoFilterMode = False
    .Range("C2").AutoFilter Field:=col, Criteria1:=Replace(sel, ",", ".")
        With .AutoFilter.Range
        Set Plage = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
            For Each cel In Plage
               
                With resultatbase.ListView1
                    .ListItems.Add , , cel
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 3)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 4)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 5)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 6)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 7)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 8)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 9)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 10)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 11)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Offset(0, 12)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Row
                End With
            GoTo ici:
            Next
        End With
End With
End If
Next
ici:
Next
Unload Me

End Sub

reste a filtrer les doublons de la listview
A+

 

[osiris150]

Re : problème filtrage et tri dans userform

Bonjour fhoest,

Je viens de modifier le fichier en intégrant un bouton supplémentaire dans la sélection. Par contre il subsiste un petit problème. Lors de l'affichage du résultat lors d'une recherche partielle. exemple si un mot est présent sur 2 lignes différentes dans la base de données. Il n'y a qu'une ligne sur les deux qui s'affichent. De plus, il s'affiche tout le temps la première ligne enregistré dans la base de données lors de l'affichage du résultat.

Voilà, désolé de solliciter encore votre aide.
Merci d'avance
Nicolas

Ci-joint le fichier

 

[fhoest]

Re : problème filtrage et tri dans userform

Bonsoir
code a remplacer par ceci:

Private Sub Recherchepartielle_Click()
'mettre option compare text en haut de chaque userform pour syntaxe like
Sheets("Base").AutoFilterMode = False
Dim efface As Boolean
efface = True
Dim cel As Range
mot = InputBox("entrer le mot a chercher")
Range("C2:m" & Range("b3").End(xlDown).Row).Select
For Each cel In Range("C2:m" & Range("b3").End(xlDown).Row) '
If cel Like ("*" & mot & "*") Then
With Sheets("Base")
If efface = True Then
resultatbase.ListView1.ListItems.Clear
efface = False
End If
                With resultatbase.ListView1
                    .ListItems.Add , , Range("c" & cel.Row)
                    
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("d" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("e" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("f" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("g" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("h" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("i" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("j" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("k" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("l" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("m" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Row
                
                End With
          End With
End If
Next
End Sub

reste les doublons a gerer et ne pas oublier de mettre tout en haut de tous code confondu du userform
option compare text (important pour la syntaxe)
A bientot

 

[osiris150]

Re : problème filtrage et tri dans userform

C'est parfait maintenant ! Merci encore pour ton aide qui m'a été très précieuse.
Nicolas

 

[fhoest]

Re : problème filtrage et tri dans userform

Bonsoir,
merci mais parfait c'est sans les doublons (pour moi) et encore parfait c'est beaucoup trop.

Private Sub Recherchepartielle_Click()
'mettre option compare text en haut de chaque userform pour syntaxe like
Sheets("Base").AutoFilterMode = False
Dim efface As Boolean
dim doublon  as long

efface = True
Dim cel As Range
mot = InputBox("entrer le mot a chercher")
Range("C2:m" & Range("b3").End(xlDown).Row).Select
For Each cel In Range("C2:m" & Range("b3").End(xlDown).Row) '
If cel Like ("*" & mot & "*") Then
With Sheets("Base")
If efface = True Then
resultatbase.ListView1.ListItems.Clear
efface = False
End If
if doublon=c.row then 
goto suivant
else:
doublon=cel.row
 end if 
               With resultatbase.ListView1
                    .ListItems.Add , , Range("c" & cel.Row)
                    
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("d" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("e" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("f" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("g" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("h" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("i" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("j" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("k" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("l" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , Range("m" & cel.Row)
                    .ListItems(.ListItems.Count).ListSubItems.Add , , cel.Row
suivant:                
                End With
          End With
End If
Next
End Sub

Voici pour toi.
Au plaisir et bon week end .
N'hésite pas a revenir au cas ou?