Moteur de recherche avec exclusion + affichage des résultats dans un label
Bonjour à tous,
Je fais appel à vos talents respectifs dans le but de résoudre deux problématiques que je rencontre dans le cadre de la création d'un petit outil sous Excel en VBA.
J'ai un tableau qui contient un certain nombre de données (départements, régions, caisse de gestion, responsables commerciaux ...) et j'aimerais, par l'intermédiaire d'un UserForm, intégrer un moteur de recherche + affichage des résultats dans les labels.
> Moteur de recherche : il fonctionne mais j'aimerais exclure les tirets et les accents afin de fluidifier la recherche et pouvoir combiner les données de la colonne A et B. Par ailleurs, les numéros de départements de la colonne A ne sont pas pris en compte dans les résultats :
Private Sub TextBox1_Change()
Dim filtre As String
filtre = "*" & Me.TextBox1.Text & "*"
If Sheets("Synthèse").AutoFilterMode Then
Sheets("Synthèse").AutoFilterMode = False
End If
Sheets("Synthèse").Range("A2:B46").AutoFilter Field:=2, Criteria1:=filtre
End Sub
> Affichage des résultats dans les labels : je bloque sur ce point ! J'ai réussi à relier les labels à ligne 2 de mon tableau mais si le résultat de recherche nous renvoi à une autre ligne, l'affichage reste bloqué sur la ligne 2.
Pourriez-vous m'aider sur ces deux points ? Je joins le fichier Excel en pièce jointe.
Bonne journée et joyeuses fêtes à tous,
bonjour ugogmnt,
un essai, vous pouvez le faire avec
- le numéro du département
- une partie du nom du département
- le numéro & une partie du nom (plutôt bête parce qu'on l'a déjà avec le numéro)
Private Sub TextBox1_Change()
Dim filtre As String, s, sp, i, b
On Error Resume Next
Sheets("Synthèse").AutoFilter.Range.AutoFilter
On Error GoTo 0
If Sheets("Synthèse").AutoFilterMode Then
Sheets("Synthèse").AutoFilterMode = False
End If
With TextBox1
If Len(.Text) = 0 Then Exit Sub
s = .Text
sp = Split(s) 'séparer sur l'espace
End With
With Sheets("Synthèse").Range("A2:B46")
b = IsNumeric(sp(0)) 'la première partie est numérique
If b Then .AutoFilter Field:=1, Criteria1:=--sp(0) 'filtrer colonne A
If b Then s = Mid(s, Len(sp(0)) + 1) 'supprimer ce numéro du reste
If Len(s) > 0 Then .AutoFilter 2, "*" & s & "*" 'filtrer colonne B
End With
End SubSalut Ugo,
Salut BsAlv
Private Sub TextBox1_Change()
'
Dim iRow%, filtre$
'
filtre = "*" & Me.TextBox1.Text & "*"
With Sheets("Synthèse")
If .AutoFilterMode Then .AutoFilterMode = False
.Range("A2:B46").AutoFilter Field:=2, Criteria1:=filtre
iRow = .Range("A1").Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Row
Label21.Caption = .Range("A" & iRow).Value
Label22.Caption = .Range("B" & iRow).Value
Label31.Caption = .Range("C" & iRow).Value
Label71.Caption = .Range("G" & iRow).Value
Label82.Caption = .Range("H" & iRow).Value
Label101.Caption = .Range("I" & iRow).Value
Label111.Caption = .Range("J" & iRow).Value
Label41.Caption = .Range("D" & iRow).Value
Label51.Caption = .Range("E" & iRow).Value
Label61.Caption = .Range("F" & iRow).Value
End With
'
End SubJoyeux réveillon!
A+
@curulis57 @BsaAIv
Merci beaucoup pour vos deux réponses !
La recherches par numéro fonctionne et l'intégration des résultats en labels fonctionne également, comment puis-je combiner vos deux codes en un seul ?
Aussi, sauriez vous ajouter une fonction d'exclusion des accents et des tirets ?
Merci à vous,
re,
Private Sub TextBox1_Change()
Dim filtre As String, s, sp, iRow, b
On Error Resume Next
Sheets("Synthèse").AutoFilter.Range.AutoFilter
On Error GoTo 0
If Sheets("Synthèse").AutoFilterMode Then
Sheets("Synthèse").AutoFilterMode = False
End If
With TextBox1
If Len(.Text) = 0 Then GoTo Labels
s = .Text
sp = Split(s) 'séparer sur l'espace
End With
With Sheets("Synthèse").Range("A1:B46")
b = IsNumeric(sp(0)) 'la première partie est numérique
If b Then .AutoFilter Field:=1, Criteria1:=--sp(0) 'filtrer colonne A
If b Then s = Trim(Mid(s, Len(sp(0)) + 1)) 'supprimer ce numéro du reste
If Len(s) > 0 Then .AutoFilter 2, "*" & s & "*" 'filtrer colonne B
If .Columns(1).SpecialCells(xlVisible).Count > 1 Then iRow = .Offset(1).Columns(1).SpecialCells(xlVisible).Cells(1).Row
End With
Labels:
With Sheets("Synthèse")
If iRow > 0 Then
Label21.Caption = .Range("A" & iRow).Value
Label22.Caption = .Range("B" & iRow).Value
Label31.Caption = .Range("C" & iRow).Value
Label71.Caption = .Range("G" & iRow).Value
Label82.Caption = .Range("H" & iRow).Value
Label101.Caption = .Range("I" & iRow).Value
Label111.Caption = .Range("J" & iRow).Value
Label41.Caption = .Range("D" & iRow).Value
Label51.Caption = .Range("E" & iRow).Value
Label61.Caption = .Range("F" & iRow).Value
Else
Label21.Caption = "-"
Label22.Caption = "-"
Label31.Caption = "-"
Label71.Caption = "-"
Label82.Caption = "-"
Label101.Caption = "-"
Label111.Caption = "-"
Label41.Caption = "-"
Label51.Caption = "-"
Label61.Caption = "-"
End If
End With
'
End Sub
Private Sub UserForm_Activate()
Exit Sub
UserForm1.Label21.Caption = Sheets("Synthèse").Range("A2").Value
UserForm1.Label22.Caption = Sheets("Synthèse").Range("B2").Value
UserForm1.Label31.Caption = Sheets("Synthèse").Range("C2").Value
UserForm1.Label71.Caption = Sheets("Synthèse").Range("G2").Value
UserForm1.Label82.Caption = Sheets("Synthèse").Range("H2").Value
UserForm1.Label101.Caption = Sheets("Synthèse").Range("I2").Value
UserForm1.Label111.Caption = Sheets("Synthèse").Range("J2").Value
UserForm1.Label41.Caption = Sheets("Synthèse").Range("D2").Value
UserForm1.Label51.Caption = Sheets("Synthèse").Range("E2").Value
UserForm1.Label61.Caption = Sheets("Synthèse").Range("F2").Value
End SubSalut Ugo, BsAlv,
un truc que j'avais fait il y un petit temps déjà et que j'ai enfin amélioré et finalisé... enfin, j'espère!
En feuille 'BDD', tu places tes données brutes.
Tu ajoutes ou retires un intitulé de colonne avec répercussion immédiate dans la feuille de recherche 'REC'.
Par double-clic sur un en-tête de colonne, qui vire à l'orange, tu incorpores cette colonne dans les critères de recherche de la feuille 'REC'.
Un double-clic hors en-tête de colonne provoque un tri ascendant des données sur base de cette colonne.
Un clic droit, un tri descendant.
En feuille 'REC', tu fais la recherche via la TextBox encadrée de 2 boutons de commande.
Tu tapes les lettres ou chiffres (selon colonnes incorporées dans la recherche) les plus appropriés et la macro recherche l'occurrence dans les colonnes de 'BDD'.
Tu peux taper des lettres situées n'importe où dans le mot recherché : pas besoin de commencer par le début du mot.
Si tu veux modifier ou supprimer une ligne de données, tu cliques sur un item de la ligne pour l'afficher en ligne 2, colorée en brun clair.
Tu corriges l'item et clique sur le bouton de gauche pour transfert vers 'BDD', le bouton de droite pour supprimer la ligne.
Á tester.
A+
re, salut Curulis57
la solution pour les accents, c'est une colonne supplémentaire sans accents (sauf l'accent de Cote d'Or pour le moment).
Bonjour BsAlv,
à vrai dire, je n'ai pas trop compris cette demande : qu'as-tu compris, toi?
re,
ce filtrage, c'est en "arrière-plan", il/elle veut utiliser son UF et montrer la première occurence
Non, pas ça, mais cette histoire d'accents!
re,
on veut filtrer sans accents, donc si le filtre est "co", Côte d'Or reste visible, avec "Corse du " que les 2 Corses restent visible, etc
Je pourrais éventuellement intégrer ce genre de choses... quoique je n'en vois pas l'utilité, les accents et autres tirets favorisant justement un ciblage plus rapide!
A+
Bonjour et bonnes Fêtes,
MERCI beaucoup pour vos retours, ça fonctionne très bien !
J'ai finalement ajouter une troisième colonne (C) comprenant la liste des départements sans accents ni tirets.
Toutefois, je n'arrive pas à ajouter cette colonne dans la macro afin que la recherche soit effectuée sur les colonne 1 + 2 + 3 :
Private Sub TextBox1_Change()
Dim filtre As String, s, sp, iRow, b
On Error Resume Next
Sheets("Synthèse").AutoFilter.Range.AutoFilter
On Error GoTo 0
If Sheets("Synthèse").AutoFilterMode Then
Sheets("Synthèse").AutoFilterMode = False
End If
With TextBox1
If Len(.Text) = 0 Then GoTo Labels
s = .Text
sp = Split(s) 'séparer sur l'espace
End With
With Sheets("Synthèse").Range("A1:C46")
b = IsNumeric(sp(0)) 'la première partie est numérique
If b Then .AutoFilter Field:=1, Criteria1:=--sp(0) 'filtrer colonne A
If b Then s = Trim(Mid(s, Len(sp(0)) + 1)) 'supprimer ce numéro du reste
If Len(s) > 0 Then .AutoFilter 2, "*" & s & "*" 'filtrer colonne B
If Len(s) > 0 Then .AutoFilter 3, "*" & s & "*" 'filtrer colonne C -> NE FONCTIONNE PAS
If .Columns(1).SpecialCells(xlVisible).Count > 1 Then iRow = .Offset(1).Columns(1).SpecialCells(xlVisible).Cells(1).Row
End With
Labels:
With Sheets("Synthèse")
If iRow > 0 Then
Label31.Caption = .Range("A" & iRow).Value
Label32.Caption = .Range("B" & iRow).Value
Label41.Caption = .Range("D" & iRow).Value
Label81.Caption = .Range("H" & iRow).Value
Label91.Caption = .Range("I" & iRow).Value
Label101.Caption = .Range("J" & iRow).Value
Label111.Caption = .Range("K" & iRow).Value
Label51.Caption = .Range("E" & iRow).Value
Label61.Caption = .Range("F" & iRow).Value
Label71.Caption = .Range("G" & iRow).Value
Else
Label31.Caption = ""
Label32.Caption = ""
Label41.Caption = ""
Label81.Caption = ""
Label91.Caption = ""
Label101.Caption = ""
Label111.Caption = ""
Label51.Caption = ""
Label61.Caption = ""
Label71.Caption = ""
End If
End With
'
End Sub
Private Sub UserForm_Activate()
Exit Sub
UserForm1.Label31.Caption = Sheets("Synthèse").Range("A2").Value
UserForm1.Label32.Caption = Sheets("Synthèse").Range("B2").Value
UserForm1.Label41.Caption = Sheets("Synthèse").Range("D2").Value
UserForm1.Label81.Caption = Sheets("Synthèse").Range("H2").Value
UserForm1.Label91.Caption = Sheets("Synthèse").Range("I2").Value
UserForm1.Label101.Caption = Sheets("Synthèse").Range("J2").Value
UserForm1.Label111.Caption = Sheets("Synthèse").Range("K2").Value
UserForm1.Label51.Caption = Sheets("Synthèse").Range("E2").Value
UserForm1.Label61.Caption = Sheets("Synthèse").Range("F2").Value
UserForm1.Label71.Caption = Sheets("Synthèse").Range("G2").Value
End SubMerci pour votre aide,
Hugo
If Len(s) > 0 Then .AutoFilter 2, "*" & s & "*" 'filtrer colonne B
If Len(s) > 0 Then .AutoFilter 3, "*" & s & "*" 'filtrer colonne C -> NE FONCTIONNE PASsi on fait les 2, cela ne sert à rien,
seulement la première ligne, c'est comme c'était = filtrer avec ces accents
seulement la 2eme ligne, c'est filtrer en ignorant les accents
Merci pour ce retour.
Il n'est donc pas possible de filtrer 3 colonnes ?
J'aurais aimé que la recherche puisse fonctionner avec accents (colonne 2) et sans accents (colonne 3, qui est masquée à l'affichage).
Cordialement,
re,
si on vérifie si le "textbox1" contient des accents, on filtre la colonne B, sinon l'autre colonne (chez moi 11, chez vous 3)
Merci pour ces précisions.
Je pense comprendre la logique mais le code ne fonctionne pas.
J'ai essayé en remplaçant 11 par 3 (colonne C sans accent) comme tel :
With Sheets("Synthèse").Range("A1:C46")
b = IsNumeric(sp(0))
If b Then .AutoFilter Field:=1, Criteria1:=--sp(0)
If b Then s = Trim(Mid(s, Len(sp(0)) + 1))
s1 = Replace(Replace(Replace(Replace(s, "-", " "), "è", "e"), "ô", "o"), "é", "e")
b1 = (s = s1)
If Len(s) > 0 Then .AutoFilter IIf(b1, 3, 2), "*" & s & "*" JE REMPLACE 11 PAR 3
If .Columns(1).SpecialCells(xlVisible).Count > 1 Then iRow = .Offset(1).Columns(1).SpecialCells(xlVisible).Cells(1).Row
End WithAvez-vous une solution ?
Ci-joint, le fichier :
Bonjour le forum,
Salut Ugo, BsAlv,
finalement, j'ai intégré cette demande qui, tout compte fait, peut servir.
Tant qu'à s'amuser, j'ajoute un accessoire pour visualiser la recherche.
Ce qui donne...
ou...
La recherche est évidemment toujours valable si on prend la peine de taper les lettres accentuées!
A+
Bonjour Curulis57,
C'est vraiment top !
Sauriez-vous l'intégrer dans mon UserForm (fichier ci dessus) avec affichage des résultats dans les labels ?
Je trouve que la recherche est plus large grâce à votre code.
Merci pour votre aide
Salut Ugo,
adapté à ma sauce!
- ne sachant pas trop, à ce stade, à quoi sert la feuille 'Accueil'... eh, eh, je l'ai supprimée!
- un double-clic en ligne 1 sélectionne la colonne comme critère de recherche.
- pour accéder à l'Userform1, double-clic sur la feuille sous la ligne 1.
Le gros problème de ce système, par rapport au fichier que je t'ai envoyé il y a quelques minutes, c'est que tu dois bien connaître tes données de recherche.
Par exemple : "Rhône" et "Bouches-du-Rhône" ne seront pas trouvés de la même façon alors que...
Bref, à tester!
A+