XL 2016 recherche dernière entrée correspondant à une cellule de choix

[Cobra]

Bonjour à tous,

en VBA, dans un tableau, j'ai besoin de trouver la dernière cellule qui correspondant à une cellule de choix.
j'ai un code qui me donne la première entrée en commençant par le haut du tableau, mais j'ai besoin de la dernière.

Sheets("BD").Select
Columns("A:A").Select 'selection la colonne A pour ne chercher que la
Selection.Find(Sheets("encodage").Range("A5").Value, LookIn:=xlValues).Select 'cherche la valeur de encodage A5 dans BD colonne A
Set ac = ActiveCell


en vous remerciant pour votre aide.
Christian.

 

[Staple1600]

Bonjour le fil

Une exemple avec une macro paramétrable
(on peut choisir le mot et la colonne où chercher)
Ici on cherche le mot toto dans la colonne 1 (qui est la colonne par défaut dans la macro)

Sub test()
Cherche "toto", 1
End Sub
Private Sub Cherche(Mot As String, Optional Col As Long = 1)
Dim rng As Range
Set rng = Columns(Col).Find(what:=Mot, after:=Columns(Col).Cells(1), searchorder:=xlByColumns, searchdirection:=xlPrevious)
If rng Is Nothing Then
MsgBox "Erreur, mot cherché absent!", vbCritical
Else
MsgBox "La dernière cellule contenant [ " & Mot & " ] est: " & rng.Address(0, 0)
End If
End Sub

Et ici la macro avec le mot cherché stocké en A5

Sub test2()
Cherche Sheets("BD").Range("A5").Text
End Sub

NB: je n'ai pas mis le 1, puisque par défaut colonne 1

 

[Cobra]

Bonsoir Staple 1600,

merci pour votre réponse rapide et le code,
il fonctionne bien, avec la msg box toute fois je dois sélectionner la cellule et
je ne trouve pas comment la sélectionner pour continuer la macro, je dois sélectionner la ligne entière du tableau
ici je dois chercher dans la colonne D

merci à vous
bonne soirée
Christian

 

[Staple1600]

Re

Il suffit juste d'une petite adaptation

Sub test3()
ChercheEtSelectionne "toto", 4
End Sub
Private Sub ChercheEtSelectionne(Mot As String, Optional Col As Long = 1)
Dim rng As Range
Set rng = Columns(Col).Find(what:=Mot, after:=Columns(Col).Cells(1), searchorder:=xlByColumns, searchdirection:=xlPrevious)
If rng Is Nothing Then
MsgBox "Erreur, mot cherché absent!", vbCritical
Else
rng.EntireRow.Select
End If
End Sub

 

[Staple1600]

Re

Et la version se basant sur le contenu de la cellule A5

Sub test4()
Set f = Sheets("BD")
If IsEmpty(f.[A5]) Then f.[A5] = InputBox("Valeur à inscrire en A5", "Mot à chercher", "Test")
ChercheEtSelectionne f.Range("A5").Text, 4
End Sub

 

[Cobra]

re Bonsoir Staple 1600,

merci cela fonctionne parfaitement grace à votre aide.
pour info voici mon code terminer

Sub recherche_plaque()
Sheets("encodage").Unprotect 'pour pouvoir inscrire dans des cellules protégées
Sheets("BD").Select
ChercheEtSelectionne Sheets("encodage").Range("A11").Text

Selection.Copy
Sheets("encodage").Select
'Row("140:140").Select
Range("A140").Select ' recopie la ligne complette dans encodage le formulaire va chercher dans cette ligne les donn?e d?j? encod?es
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("AQ3").Select 'se positionne dans le formulaire ? la date de d?chargement
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True 'pour re prot?g?es la feuille
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
Private Sub ChercheEtSelectionne(Mot As String, Optional Col As Long = 4)
Dim rng As Range
Set rng = Columns(Col).Find(what:=Mot, after:=Columns(Col).Cells(1), searchorder:=xlByColumns, searchdirection:=xlPrevious)
If rng Is Nothing Then
MsgBox "Erreur, mot cherch? absent!", vbCritical
Else
rng.EntireRow.Select
End If
End Sub

encore merci

 

[Staple1600]

Re

Merci pour ton retour
Un petit bonus avant d'aller au dodo

Sub recherche_plaque()
Dim f As Worksheet
Set f = Sheets("encodage")
f.Unprotect
Application.ScreenUpdating = False
ChercheEtCopie Sheets("BD"), f, f.Range("A11").Text
f.Activate
f.Range("AQ3").Select
f.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True  'pour re prot?g?es la feuille
f.EnableSelection = xlUnlockedCells
End Sub
Private Sub ChercheEtCopie(Source As Worksheet, Desti As Worksheet, Mot As String, Optional Col As Long = 4)
Dim rng As Range, rng2 As Range
Set rng = Source.Columns(Col).Find(what:=Mot, after:=Source.Columns(Col).Cells(1), searchorder:=xlByColumns, searchdirection:=xlPrevious)
If rng Is Nothing Then
MsgBox "Erreur, mot cherché absent!", vbCritical
Else
Set rng2 = Desti.Range("A140")
rng.EntireRow.Copy: rng2.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End Sub

 

[Staple1600]

Bonjour le fil,

Encore une petite révision de macro

Sub recherche_plaque()
Dim f As Worksheet
Set f = Sheets("encodage")
f.Unprotect
Application.ScreenUpdating = False
ChercheEtCopie Sheets("BD"), f, xlPasteValues, f.Range("A11").Text
'Si tu veux changer le type de collage, tu as le choix
'La liste des différentes possibilités de collage apparaît lorsque tu modifies la ligne
'ChercheEtCopie Sheets("BD"), f, xlPasteValuesAndNumberFormats, f.Range("A11").Text
f.Activate
Range("AQ3").Select
f.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True  'pour re prot?g?es la feuille
f.EnableSelection = xlUnlockedCells
End Sub
Private Sub ChercheEtCopie(Source As Worksheet, Desti As Worksheet, collage As XlPasteType, Mot As String, Optional Col As Long = 4)
Dim rng As Range, rng2 As Range
Set rng = Source.Columns(Col).Find(what:=Mot, after:=Source.Columns(Col).Cells(1), searchorder:=xlByColumns, searchdirection:=xlPrevious)
If rng Is Nothing Then
MsgBox "Erreur, mot cherché absent!", vbCritical
Else
Set rng2 = Desti.Range("A140")
rng.EntireRow.Copy: rng2.PasteSpecial Paste:=collage
Application.CutCopyMode = False
End If
End Sub

 

[Cobra]

Bonjour Staple 1600,

merci pour ces raccourcis, en les regardant / étudiant, je me dis que je devrais revoir toutes mes macros pour les accélérer !

encore merci pour ton aide
Bon dimanche
Christian

 

[Staple1600]

Re

C'est le but:
piquer la curiosité du demandeur pour qu'il prenne plaisir à aller mettre le nez dans son VBE