[VB6 - VBA]Optimisation de .find sous excel 2003

Question

Bonjour,
je souhaite optimiser mon temps de recherche qui devient long
J'ai récupéré et adapté ce bout de code afin de récupérer les infos de patients en saisissant le nom. L'objectif est de scanner les homonymes et proposer dans une listbox les prénoms et DDN (dates de naissances) pour sélectionner le bon. Merci d'avance
Voici le bout de code concerné:

ScreenUpdating = False
Dim Cherche, Ix As Long, PrAddress
Dim Cle As String
Workbooks.Open Filename:="\DiskStation\DOSSIERS PATIENTS\FICHES ADMINISTRATIVES PATIENTS\BDD PATIENTS.xls", Password:="coucou", ReadOnly:=True
    With Workbooks("BDD PATIENTS.xls").Sheets("Feuil1").Range("D:D")'ma liste de nom est en colonne D
        Set Cherche = .Find(nom)
        If Not Cherche Is Nothing Then
            PrAddress = Cherche.Address
            Do
                ReDim Preserve Tb2(Ix)
                ReDim Preserve Tbl(Ix)
                ReDim Preserve TB(Ix)
                ReDim Preserve tableau(Ix)
                TB(Ix) = Cherche.Row
                Tbl(Ix) = Cherche.Offset(0, 1).Value 'je recupère le prénom
                Tb2(Ix) = Cherche.Offset(0, 4).Value 'je recupère la DDN
                tableau(Ix) = Tbl(Ix) & " " & Tb2(Ix) 'je compile les 2 pour selectionner le bon dans une listbox
              
            Set Cherche = .FindNext(Cherche)
                Ix = Ix + 1
                With ListBox1
                .Clear
                .List = tableau
            End With
            Loop While Not Cherche Is Nothing And Cherche.Address <> PrAddress
        Else 
        ListBox1.Clear
            Dim Txt As String
            Txt = "PATIENT INCONNU,"
            Txt2 = "vérifier l'orthographe"
            ListBox1.AddItem Txt
            ListBox1.AddItem Txt2

        End If
    End With
    Workbooks("BDD PATIENTS.xls").Close SaveChanges:=False

     Set Cherche = Nothing 'Libére la mémoire occupée par l'objet.
ScreenUpdating = True

cs_MPi · Answer

Bonjour,

Bienvenue sur le forum.
Quand tu dépose un bout de code, utilise le 3e icone à partir de la droite pour formater ton code. Tu sélectionnes le code, puis tu choisis VB dans la liste de choix de ce 3e bouton.

Set Cherche = .FindNext(Cherche) 
Ix = Ix + 1 
  With ListBox1 
    .Clear 
    .List = tableau 
  End With 
Loop While Not Cherche Is Nothing And Cherche.Address <> PrAddress

Je pense que tu pourrais charger la liste seulement à la fin de la boucle Loop.

Tu pourrais mettre une variable Boolean si tu trouves au moins une valeur et, à la sortie de ta boucle, tu vérifies si elle est True.
Si oui, tu charges ta listbox.

Autrement, il n'y a pas de recette miracle avec Find/FindNext

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

Utilisateur anonyme · Answer

Bonjour,

Si la rapidité prime sur l'exactitude (comme être certain que deux Pierre Dupont ne sont pas réellement deux Pierre Dupont différents); tu peux passer par les filtres au lieu de passer par Find. Pour préserver la feuille initiale, un filtre élaboré avec extraction sur une nouvelle feuille devrait être efficace dans ce cas.

L'enregistreur de macros devrait te fournir un bon canevas à compléter et élaguer.

[VB6 -> VBA]Optimisation de .find sous excel 2003

2 réponses

Votre réponse

Discussions similaires