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

Signaler
-
 Utilisateur anonyme -
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

2 réponses

Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
19
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

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.