[VBA] - Arrêter une recherche lorsque le dernier élément est trouvé
Bonjour,
Savez-vous comment je pourrais m'y prendre pour arrêter une recherche lorsque le dernier résultat est trouvé ?
Parfois Excel parcours des milliers de lignes sans intérêt et, pour améliorer la procédure (et éventuellement agrandir la base de données) j'aimerais qu'Excel se focalise sur ce qui doit être cherché et s'arrête une fois fait.
Voici le code de recherche pour le moment :
Sub Savedatabase()
Dim i4 As Integer
Dim plagesaisie As Range, re As Range, tve As Range, z As Range, plge As Range, plge2 As Range
Dim Tiu%, esp%, Tc%
Set sa = Worksheets("Saisie")
Set co = Worksheets("Correspondances")
lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
lcco = co.Cells(1, co.Columns.Count).End(xlToLeft).Column
lrsa = sa.Cells(Rows.Count, 1).End(xlUp).Row
For Tiu = 1 To lcco ' cherche identifiant unique
If co.Cells(1, Tiu) = "Identifiant unique" Then
Set plge = co.Range(Cells(1, Tiu), Cells(lrco, Tiu)) ' set plage identifiant unique
Exit For
End If
Next Tiu
' For Tc = 1 To lcco ' cherche correspondance
' If co.Cells(1, Tc) = "Correspondance" Then
' Set plge2 = co.Range(Cells(1, Tc), Cells(lrco, Tc)) ' set plage correspondance
' Exit For
' End If
' Next Tc
' Set plagesaisie = Cells(tve, lrco) 'tve
For Tc = 1 To lcco ' cherche correspondance
If co.Cells(1, Tc) = "Correspondance" Then
For esp = 1 To lcco ' cherche especes
If co.Cells(1, esp) = "especes" Then
With sa
For i4 = 2 To lrsa
Set re = plge.Find(.Cells(i4, 1), lookat:=xlWhole)
If Not re Is Nothing Then
.Cells(i4, 2) = re.Offset(, Tc - Tiu) 're.Offset(, 4) 're.Offset(, Tc - Tiu) ' colonne identifiant unique moins colonne correspondance
.Cells(i4, 4) = re.Offset(, esp - Tiu)
Else
End If
Next
End With
Exit For
End If
Next esp
Exit For
End If
Next Tc
End Sub
Je joins aussi un fichier si besoin.
Dans mon exemple, une fois qu'Excel a trouvé "BB69" soit le 120ème résultat, il n'a pas besoin de parcourir les 880 lignes restantes.
Merci de votre attention
Bonne journée !
A plus tard.
Bonjour,
Testes ceci :
Sub Savedatabase()
Dim Plage As Range
Dim PlgCode As Range
Dim Cel As Range
Dim Trouve As Range
With Worksheets("Saisie"): Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
With Worksheets("Correspondances"): Set PlgCode = .Range(.Cells(2, 5), .Cells(.Rows.Count, 5).End(xlUp)): End With
For Each Cel In PlgCode
Set Trouve = Plage.Find(Cel.Value, , xlValues, xlWhole)
If Not Trouve Is Nothing Then
Trouve.Offset(, 3).Value = Cel.Offset(, -1).Value
Trouve.Offset(, 1).Value = Cel.Offset(, -2).Value
'ici le reste des valeurs voulues
End If
Next Cel
End SubBonjour,
Pour le moment je n'arrive pas à l'adapter, j'ai besoin d'écrire :
Trouve.Offset(, -8).Value = Cel.Offset(, esp - Tiu).ValueMais le "-8" génère une erreur, alors qu'il s'agit de la 8ème colonne à gauche de "Trouve".
Merci pour la proposition, j'espère arriver à trouver d'où vient ce soucis !
Voilà ! J'avais oublié un Exit for, ce qui fait qu'une boucle poursuivait et donnait un mauvais résultat pour trouver la bonne colonne (car elles peuvent bouger...).
J'ai suivi l'exécution du code pas à pas, et ça exécute bien ce que j'espérais.
Merci beaucoup pour votre aide !