Macro Recherche de classeur à colonne

adi399

XLDnaute Occasionnel
Bonjour à tous,

je recherche depuis quelques temps comment réalisé une macro pour faire une recherche dans une feuille, à force de chercher à droite et à gauche j'ai réussi à adapter le code ci-dessous, et je remercie la personne qui l'a réalisé en partie:

Code:
Option Explicit
Sub TrouverMotChoix()
Dim Mot As String
Dim Ws As Object
Dim Nbre As Long
Dim Cycle As Long
Dim Trouvé As Variant
Dim CellAddress As Variant
Dim MyValue As String

'Définition de la variable à rechercher
Mot = InputBox("Saisir le N° de caisse à chercher.", Title:="Recherche")
'Vérification si existante
If Mot = "" Then Exit Sub
For Each Ws In Worksheets
Nbre = Nbre + Application.CountIf(Ws.UsedRange, "=" & Mot)
Next Ws
'Message en cas de mot inexistant
If Nbre = 0 Then
MyValue = MsgBox(" Le n° de caisse " & Mot & " n'est pas enregistrée ", vbOKOnly, " Message ")
Else
Cycle = 0
'Recherche et arrêt sur les cellules contenant le Mot
For Each Ws In Worksheets
With Ws
.Activate
Set Trouvé = .Cells.Find(What:=Mot, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart)
If Not Trouvé Is Nothing Then
CellAddress = Trouvé.Address
Do
Cycle = Cycle + 1
Trouvé.Activate
If Nbre = 1 Then
MyValue = MsgBox(" Le n° de caisse " & Mot & " est enregistrée 1 seule fois ", vbOKOnly, " Message ")
Exit Sub
End If
If Cycle = Nbre Then
MyValue = MsgBox(" Le n° de caisse " & Mot & " sélectionnée est la dernière !", vbOKOnly, "Message")
Sheets("Feuil1").Activate
Range("A1").Select
Exit Sub
Else
MyValue = MsgBox(" Le n° de caisse " & Mot & " sélectionnée est la " & Cycle & " sur " & Nbre & " existantes. " & vbLf & _
" Voulez vous continuer la recherche ? ", vbYesNo, "Message")
If MyValue = vbNo Then Exit For
Set Trouvé = .Cells.FindNext(After:=Trouvé)
End If
Loop While Not Trouvé Is Nothing And Trouvé.Address <> CellAddress
End If
End With
Next Ws
End If
End Sub

maintenant voila, la recherce est effectué dans toute la feuille, j'aimerai adapté mon code pour qu'il réalise la recherche uniquement dans la plage de donnée (F12;F65536). J'espère ainsi diminué le temps de recherche qui peut s'averer être long....

Merci d'avance à ceux qui pourront m'aider!
 

Excel-lent

XLDnaute Barbatruc
Re : Macro Recherche de classeur à colonne

Bonjour Adi399,

Le code suivant :
Dim Ws As Object
...
For Each Ws In Worksheets

Il teste toutes les cellules de toutes les feuilles! Normal que ta macro rame.

L'idéal, comme demandé est de restraindre le champ aux cellules concernés (l'idéal serait de préciser également la(es) feuille(s))

Pour cela :
Dim Cellules As Range
...
For Each Cellules In Sheets("Feuil1").Range("F12:F65536")

Bonne après midi
 
Dernière édition:

Efgé

XLDnaute Barbatruc
Re : Macro Recherche de classeur à colonne

Bonjour adi399 , Excel-lent ; ) ___Si il faut boucler sur toutes les feuilles et gagner du temps: utiliser__
VB:
Set Trouvé = .Range("F2:F65530").Find
et__
VB:
Set Trouvé = .Range("F2:F65530").FindNext
__mettre en comentaire _
VB:
Trouvé.Activate
__qui ne sert à rien___Cordialement
 

adi399

XLDnaute Occasionnel
Re : Macro Recherche de classeur à colonne

Bonjour Efgé et Excel-lent, et merci de votre réponse!

J'ai malheureusement pas tout compris à votre message Efgé :s dsl

Excel-lent, j'ai remplacé le code avec WS par votre code avec Cellules, par contre je retrouve WS dans la suite de mon code, dois-je le remplacé par cellules? car j'ai une erreur sur
Code:
With Ws

j'y vois pas trop clair ...
 

adi399

XLDnaute Occasionnel
Re : Macro Recherche de classeur à colonne

J'ai modifier mon code ainsi mais j'ai une erreur ( propriété ou méthode non gerée par cet objet)sur :

Nbre = Nbre + Application.CountIf(Ws.UsedRange, "=" & Mot)

Code:
Option Explicit
Sub TrouverMotChoix()
Dim Mot As String
Dim Ws As Range 
Dim Nbre As Long
Dim Cycle As Long
Dim Trouvé As Variant
Dim CellAddress As Variant
Dim MyValue As String

'Définition de la variable à rechercher
Mot = InputBox("Saisir le N° de caisse à chercher.", Title:="Recherche")
'Vérification si existante
If Mot = "" Then Exit Sub
For Each Ws In Sheets("Feuil1").Range("F12:F65536")
Nbre = Nbre + Application.CountIf(Ws.UsedRange, "=" & Mot)
Next Ws
'Message en cas de mot inexistant
If Nbre = 0 Then
MyValue = MsgBox(" Le n° de caisse " & Mot & " n'est pas enregistrée ", vbOKOnly, " Message ")
Else
Cycle = 0
'Recherche et arrêt sur les cellules contenant le Mot
For Each Ws In Worksheets
With Ws
.Activate
Set Trouvé = .Cells.Find(What:=Mot, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart)
If Not Trouvé Is Nothing Then
CellAddress = Trouvé.Address
Do
Cycle = Cycle + 1
Trouvé.Activate
If Nbre = 1 Then
MyValue = MsgBox(" Le n° de caisse " & Mot & " est enregistrée 1 seule fois ", vbOKOnly, " Message ")
Exit Sub
End If
If Cycle = Nbre Then
MyValue = MsgBox(" Le n° de caisse " & Mot & " sélectionnée est la dernière !", vbOKOnly, "Message")
Sheets("Feuil1").Activate
Range("A1").Select
Exit Sub
Else
MyValue = MsgBox(" Le n° de caisse " & Mot & " sélectionnée est la " & Cycle & " sur " & Nbre & " existantes. " & vbLf & _
" Voulez vous continuer la recherche ? ", vbYesNo, "Message")
If MyValue = vbNo Then Exit For
Set Trouvé = .Cells.FindNext(After:=Trouvé)
End If
Loop While Not Trouvé Is Nothing And Trouvé.Address <> CellAddress
End If
End With
Next Ws
End If
End Sub
 

Excel-lent

XLDnaute Barbatruc
Re : Macro Recherche de classeur à colonne

Bonsoir Adi399,

Dans mon exemple, ayant limité ta recherche à un seul onglet, je n'avais plus besoin de la variable Ws qui représente ton classeur (là où avait lieu précédemment ta recherche)

C'est pourquoi dans la définition des variables (au début de ta macro : dim... as ...) je l'ai supprimé.

Mais en effet, il fallait la supprimer partout dans ta macro, et remplacer par le nom de l'onglet.

VB:
Option Explicit
Sub TrouverMotChoix()

Dim Mot As String
Dim Cellules As Range
Dim Nbre As Long
Dim Cycle As Long
Dim Trouvé As Variant
Dim CellAddress As Variant
Dim MyValue As String

'Définition de la variable à rechercher
Mot = InputBox("Saisir le N° de caisse à chercher.", Title:="Recherche")
'Vérification si existante
If Mot = "" Then Exit Sub

For Each Cellules In Sheets("Feuil1").Range("F12:F65536")
     Nbre = Nbre + Application.CountIf(Sheets("Feuil1").UsedRange, "=" & Mot)
Next Cellules

'Message en cas de mot inexistant
If Nbre = 0 Then
     MyValue = MsgBox(" Le n° de caisse " & Mot & " n'est pas enregistrée ", vbOKOnly, " Message ")
Else
     Cycle = 0
     'Recherche et arrêt sur les cellules contenant le Mot
           With Sheets("Feuil1")
              .Activate
              Set Trouvé = .Cells.Find(What:=Mot, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart)

              If Not Trouvé Is Nothing Then
                   CellAddress = Trouvé.Address
                   Do
                   Cycle = Cycle + 1
                   Trouvé.Activate
                            If Nbre = 1 Then
                                  MyValue = MsgBox(" Le n° de caisse " & Mot & " est enregistrée 1 seule fois ", vbOKOnly, " Message ")
                                  Exit Sub
                             End If

                             If Cycle = Nbre Then
                                   MyValue = MsgBox(" Le n° de caisse " & Mot & " sélectionnée est la dernière !", vbOKOnly, "Message")
                                   Sheets("Feuil1").Activate
                                   Range("A1").Select
                                   Exit Sub
                             Else
                                   MyValue = MsgBox(" Le n° de caisse " & Mot & " sélectionnée est la " & Cycle & " sur " & Nbre & " existantes."
                                   & vbLf & _
                                   " Voulez vous continuer la recherche ? ", vbYesNo, "Message")

                                   If MyValue = vbNo Then Exit For
                            Set Trouvé = .Cells.FindNext(After:=Trouvé)
                            End If
                  Loop While Not Trouvé Is Nothing And Trouvé.Address <> CellAddress
              End If
           End With
End If
End Sub

N'ayant pu tester la macro, et ne connaissant pas tous les tenant et les aboutissant je ne garantie rien, mais voici l'idée.

Désolé de ne pouvoir faire plus!

Bonne fin soirée
 

Statistiques des forums

Discussions
312 305
Messages
2 087 090
Membres
103 464
dernier inscrit
Inconnu2