Fonction recherche avec VBA

UltrAzimut

XLDnaute Nouveau
Bonjour,

Dans mon projet actuel, je développe une fonction recherche. Apres de nombreux bug :D deux fonctions semblent fonctionner mais je souhaite conserver la "meilleure". La fonction en question recherche si un client existe dans ma base.

Premiere solution :

Code:
Private Sub rechercher_Click()

Dim var As String
Dim ligne As Integer
var = UCase(UserForm2.recherche.Value)

    If var = "" Then
        msgbox "Veuillez indiquer Le nom du client !", vbInformation, "Attention"
    End If
    
    If var <> "" Then
        Sheets("societes").Select
        On Error Resume Next 'si erreur a la ligne suivante on continu quand meme
        Cells.Find(What:=var, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
        If Err = 0 then 'si pas d'erreur
            'Activer la cellule la plus à gauche
            ligne = ActiveCell.Row
            Cells(ligne, 1).Select
  
           'Inscrire les résultats de la recherche dans les champs correspondants
            UserForm2.modification.Value = ActiveCell.Offset(0, 1).Text
            UserForm2.cloture.Value = ActiveCell.Offset(0, 2).Text
            UserForm2.naturejuridique.Value = ActiveCell.Offset(0, 3).Text
            UserForm2.raisonsociale.Value = ActiveCell.Offset(0, 4).Text
            UserForm2.anciennement.Value = ActiveCell.Offset(0, 5).Text
            UserForm2.numero.Value = ActiveCell.Offset(0, 6).Text
            UserForm2.voie.Value = ActiveCell.Offset(0, 7).Text
            UserForm2.adresse.Value = ActiveCell.Offset(0, 8).Text
            UserForm2.BP.Value = ActiveCell.Offset(0, 10).Text
            UserForm2.CP.Value = ActiveCell.Offset(0, 11).Text
            UserForm2.ville.Value = ActiveCell.Offset(0, 12).Text
            UserForm2.telephone.Value = ActiveCell.Offset(0, 13).Text
            UserForm2.siret.Value = ActiveCell.Offset(0, 14).Text
            UserForm2.representants.Value = ActiveCell.Offset(0, 17).Text
            UserForm2.qualite.Value = ActiveCell.Offset(0, 18).Text
            UserForm2.pouvoirs.Value = ActiveCell.Offset(0, 19).Text
            UserForm2.infos.Value = ActiveCell.Offset(0, 20).Text
        Else 'si erreur il y a
           Msgbox "Le client n'existe pas!", VbEclamation, "Erreur Client..."
           Err.Clear
        End If
    End If
End Sub

Deixieme solution :

Code:
Private Sub rechercher_Click()

Dim var As String
Dim ligne As Integer
var = UCase(UserForm2.recherche.Value)

    If var = "" Then
        msgbox "Veuillez indiquer Le nom du client !", vbInformation, "Attention"
    End If
   
   
    If var <> "" Then
            With Worksheets("societes")
            .Activate
            Dim search As Range
            Set search = Cells.Find(What:=var, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= False)
                       
            If Not search Is Nothing Then
            search.Activate
            Sheets("societes").Select
            'Activer la cellule la plus à gauche
            ligne = ActiveCell.Row
            Cells(ligne, 1).Select
 
            'Inscrire les résultats de la recherche dans les champs correspondants
            UserForm2.modification.Value = ActiveCell.Offset(0, 1).Text
            UserForm2.cloture.Value = ActiveCell.Offset(0, 2).Text
            UserForm2.naturejuridique.Value = ActiveCell.Offset(0, 3).Text
            UserForm2.raisonsociale.Value = ActiveCell.Offset(0, 4).Text
            UserForm2.anciennement.Value = ActiveCell.Offset(0, 5).Text
            UserForm2.numero.Value = ActiveCell.Offset(0, 6).Text
            UserForm2.voie.Value = ActiveCell.Offset(0, 7).Text
            UserForm2.adresse.Value = ActiveCell.Offset(0, 8).Text
            UserForm2.BP.Value = ActiveCell.Offset(0, 10).Text
            UserForm2.CP.Value = ActiveCell.Offset(0, 11).Text
            UserForm2.ville.Value = ActiveCell.Offset(0, 12).Text
            UserForm2.telephone.Value = ActiveCell.Offset(0, 13).Text
            UserForm2.siret.Value = ActiveCell.Offset(0, 14).Text
            UserForm2.representants.Value = ActiveCell.Offset(0, 17).Text
            UserForm2.qualite.Value = ActiveCell.Offset(0, 18).Text
            UserForm2.pouvoirs.Value = ActiveCell.Offset(0, 19).Text
            UserForm2.infos.Value = ActiveCell.Offset(0, 20).Text
            Else
            msgbox "Le client n'existe pas !", vbExclamation, "Erreur Client..."
            End If
            End With
    End If
End Sub

Question subsidiaire : Si je veux rechercher dans une colonne precise, je met :
Code:
Columns(4).cells.fin(...)
mais ça ne fonctionne pas ! Ai-je oublier quelque chose ?

Merci pour vos avis et conseils
 

tototiti2008

XLDnaute Barbatruc
Re : Fonction recherche avec VBA

Bonjour UltrAzimut,

en fait, trés peu de différences entre tes 2 procédure, alors te dire la "meilleure"...

tout ce que je peux dire, c'est que tu peux éviter les Select dans ton code, mais sinon, pas grand chose.
 

kjin

XLDnaute Barbatruc
Re : Fonction recherche avec VBA

Bonjour,
Sans fichier et sans filet
Code:
Private Sub rechercher_Click()
Dim var As String
Dim search As Range

var = UCase(UserForm2.recherche.Value)
    If var = "" Then
        msgbox "Veuillez indiquer Le nom du client !", vbInformation, "Attention"
    End If
    If var <> "" Then
            Set search = Worksheets("societes").Columns(4).Find(var)
            If Not search Is Nothing Then
[COLOR="Green"]'il faut référencer l'adresse des cellules à renvoyer par rapport à l'adresse de la cellule recherchée et trouvée sinon pourquoi faire une recherche !?[/COLOR]
            UserForm2.modification.Value = Search.Offset(0, 1).Text
[COLOR="Green"]'...La suite de ton code[/COLOR]
            Else
            msgbox "Le client n'existe pas !", vbExclamation, "Erreur Client..."
            End If

    End If
End Sub
A+
kjin
 
Dernière édition:

UltrAzimut

XLDnaute Nouveau
Re : Fonction recherche avec VBA

Bonsoir,

tout ce que je peux dire, c'est que tu peux éviter les Select dans ton code, mais sinon, pas grand chose.
Oui, il faut que je prenne cette bonne habitude. Si j'ai bien lu les différentes docs, les select ralentiraient le code ?!

>>> kjin

Le code que tu as mis fonctionne parfaitement bien apres adaptation :
Code:
Private Sub rechercher_Click()

Dim var As String
Dim search As Range

var = UCase(UserForm2.recherche.Value)
    If var = "" Then
        msgbox "Veuillez indiquer Le nom du client !", vbInformation, "Attention"
    End If
    If var <> "" Then
            Set search = Worksheets("societes").Columns(5).Find(var)
            If Not search Is Nothing Then
'il faut référencer l'adresse des cellules à renvoyer par rapport à l'adresse de la cellule recherchée et trouvée sinon pourquoi faire une recherche !?
            UserForm2.creation.Value = search.Offset(0, -4).Text
            UserForm2.modification.Value = search.Offset(0, -3).Text
            UserForm2.cloture.Value = search.Offset(0, -2).Text
            UserForm2.naturejuridique.Value = search.Offset(0, -1).Text
            UserForm2.raisonsociale.Value = search.Offset(0, 0).Text
            UserForm2.anciennement.Value = search.Offset(0, 1).Text
            UserForm2.numero.Value = search.Offset(0, 2).Text
            UserForm2.voie.Value = search.Offset(0, 3).Text
            UserForm2.adresse.Value = search.Offset(0, 4).Text
            UserForm2.BP.Value = search.Offset(0, 5).Text
            UserForm2.CP.Value = search.Offset(0, 6).Text
            UserForm2.ville.Value = search.Offset(0, 7).Text
            UserForm2.telephone.Value = search.Offset(0, 8).Text
            UserForm2.siret.Value = search.Offset(0, 9).Text
            UserForm2.representants.Value = search.Offset(0, 13).Text
            UserForm2.qualite.Value = search.Offset(0, 14).Text
            UserForm2.pouvoirs.Value = search.Offset(0, 15).Text
            UserForm2.infos.Value = search.Offset(0, 16).Text
'...La suite de ton code
            Else
            msgbox "Le client n'existe pas !", vbExclamation, "Erreur Client..."
            End If

    End If
End Sub

il faut référencer l'adresse des cellules à renvoyer par rapport à l'adresse de la cellule recherchée et trouvée sinon pourquoi faire une recherche !?
Si j'ai bien compris, référencer l'adresse des cellules composant la ligne ou la cellule a été trouvée pour ensuite les renvoyer dans les bons textbox de mon USF.
En fait, moi lors de la recherche, deja celle-ci s'effectuait sur toutes les cellules (mauvais point), lorsque que la cellule était trouvée, je me positionnais sur la cellule la plus a gauche de la ligne ou etait le résultat pour que le "offset" se réalise sur la premiere colonne et dans un ordre croissant :
Code:
UserForm2.modification.Value = ActiveCell.Offset(0, 1).Text
UserForm2.cloture.Value = ActiveCell.Offset(0, 2).Text
Bref... Je débute et j'aime bien me torturer l'esprit pour rien (je ne suis pas très logique)

En tout cas, je retiens ta soluce
merci bien :)
 

kjin

XLDnaute Barbatruc
Re : Fonction recherche avec VBA

Bonsoir,
...En fait, moi lors de la recherche, deja celle-ci s'effectuait sur toutes les cellules (mauvais point)...
Oui, vaut mieux éviter.
Tu peux encore améliorer en limitant la recherche aux cellules non vides de la colonne.Par ailleurs, Find ne renvoie que la première occurence, donc en cas de doublons...
...lorsque que la cellule était trouvée, je me positionnais sur la cellule la plus a gauche de la ligne ou etait le résultat pour que le "offset" se réalise sur la premiere colonne et dans un ordre croissant...
C'est possible aussi et dans ce cas
Private Sub rechercher_Click()
Dim var As String
Dim search As Range
var = UCase(UserForm2.recherche.Value)
If var = "" Then
msgbox "Veuillez indiquer Le nom du client !", vbInformation, "Attention"
End If
If var <> "" Then
Set search = Worksheets("societes").Columns(5).Find(var)
If Not search Is Nothing Then
Ligne = search.Row
UserForm2.creation.Value = Cells(Ligne, 1).Text
UserForm2.modification.Value = Cells(Ligne, 2).Text
'...la suite du code
Par ailleurs UserForm2.creation.Value = Cells(Ligne, 1).Text peut s'écrire
Me.creation.Value = Cells(Ligne, 1).Text et finalement
creation = Cells(Ligne, 1)
A+
kjin
 
Dernière édition:

ledzepfred

XLDnaute Impliqué
Re : Fonction recherche avec VBA

UltrAzimut,kjin,tototiti bonsoir

personnellement j'ajouterai une condition sur les valeurs approchantes (il existe peut-etre une société dont le nom est contenue dans le nom d'une autre société.
Après le if var<>"" then, je mettrai do while activecell.value<>var (et bien sur loop entre les deux end if) mais dans ce cas utiliser findnext (avec find, sachant que cela se fait sur la colonne5, la même cellule serait sélectionnée à chaque tour de boucle)
Pour les doublons pourquoi ne pas controler par
x=application.worksheetfunction (columns(5),var)
if x=0 then exit sub
if x= 1 then
le code de kjin
else
resultat=Msgbox("le fichier contient " & x & "sociétés " & Var)
end if

a+
 
Dernière édition:

tototiti2008

XLDnaute Barbatruc
Re : Fonction recherche avec VBA

Bonjour à tous,

ledzepfred, une petite correction :

Code:
x=application.worksheetfunction.[COLOR=red]countif[/COLOR](columns(5),var)
if x=0 then exit sub
if x= 1 then 
le code de kjin
else 
resultat=Msgbox("le fichier contient " & x & "sociétés " & Var)
end if

et d'un autre côté, si on sait qu'il n'y a qu'une occurrence de la valeur, moi je le ferais plutôt avec un Countif et un Match qu'avec un Find...
 

UltrAzimut

XLDnaute Nouveau
Re : Fonction recherche avec VBA

Merci encore pour vos conseils et explications !

J'ai eu la "malchance" d'apprendre que le projet était abandonné, mon chef ayant obtenu l'accord de faire installer le logiciel dédié a la gestion des dossiers, logiciel qu'on lui refusait avant... Mais j'ai décidé de continuer pour le plaisir en remaniant le code et en supprimant quelques fonctions.

Pour ceux que ça intéressent, le projet était celui ci :
Ce lien n'existe plus
ça fonctionne pas trop mal meme si mon code pour la mise a jour n'est pas terrible, je vais le corriger. Le fichier est celui avant les modif que j'ai réalisé grace a kjin.

Pour la mise a jour des données, je pense recuperer le numero de la ligne ou se trouve le resultat de la recherche pour mettre a jour les champs.

>>> ledzepfred && tototiti2008 :
Je vais aussi bosser sur vos idées.

Thx