Macro recherche

  • Initiateur de la discussion Temjeh
  • Date de début
T

Temjeh

Guest
Bonjour le forum

Oui, oui encore ce code(trouver ici) que j'utilise à toute les sauce et pour ma nouvelle compo...

Il recherche valeur dans tous les feuils et dans tous les cols.
J'aimerais le modifié pour une recherche dans toutes les feuils mais dans la col F seulement

Merci

Dim countTot As Byte
Dim counter As Byte

Dim ws As Worksheet

Dim foundCell As Range

Dim loopAddr As String

Private Sub CommandButton1_Click()

Dim countTot As Long

Dim counter As Long

Dim strSearchString As String

Dim ws As Object

Dim foundCell As Variant

Dim loopAddr As Variant

Dim returnValue As String

strSearchString = InputBox(Prompt:='Saisir la valeur à chercher.', Title:='Recherche')

If strSearchString = '' Then Exit Sub

For Each ws In Worksheets

countTot = countTot + Application.CountIf(ws.UsedRange, '=' & strSearchString)

Next ws

If countTot = 0 Then

returnValue = MsgBox(' La valeur ' & strSearchString & ' n'est pas enregistrée ', vbOKOnly, ' Message ')

Else

counter = 0

For Each ws In Worksheets

With ws

.Activate

Set foundCell = .Cells.Find(What:=strSearchString, LookIn:=xlValues, LookAt:=xlPart)

If Not foundCell Is Nothing Then

loopAddr = foundCell.Address

Do

counter = counter + 1

foundCell.Activate

If countTot = 1 Then

returnValue = MsgBox(' La valeur ' & strSearchString & ' est enregistrée 1 seule fois ', vbOKOnly, ' Message ')

Exit Sub

End If

If counter = countTot Then

returnValue = MsgBox(' La valeur ' & strSearchString & ' sélectionnée est la dernière !', vbOKOnly, 'Message')

Exit Sub

Else

returnValue = MsgBox(' La valeur ' & strSearchString & ' sélectionnée est la ' & counter & ' sur ' & countTot & ' existantes. ' & vbLf & _

' Voulez vous continuer la recherche ? ', vbYesNo, 'Message')

If returnValue = vbNo Then Exit For

Set foundCell = .Cells.FindNext(After:=foundCell)

End If

Loop While Not foundCell Is Nothing And foundCell.Address <> loopAddr

End If

End With

Next ws

End If

Merci beaucoup

Temjeh
 

Robert

XLDnaute Barbatruc
Repose en paix
Salut Temjeh, salut le forum,

J'ai remplacé deux fois dans le code .Cells par .Range('F:F') soit :
Private Sub CommandButton1_Click()
Dim countTot As Byte
Dim counter As Byte
Dim ws As Worksheet
Dim foundCell As Range
Dim loopAddr As String
Dim returnValue As String
strSearchString = InputBox(Prompt:='Saisir la valeur à chercher.', Title:='Recherche')
If strSearchString = '' Then Exit Sub
For Each ws In Worksheets
countTot = countTot + Application.CountIf(ws.Range('F:F'), '=' & strSearchString)
Next ws
If countTot = 0 Then
returnValue = MsgBox(' La valeur ' & strSearchString & ' n'est pas enregistrée ', _
vbOKOnly, ' Message ')
Else
counter = 0
For Each ws In Worksheets
With ws
.Activate
'Range('F:F') au lieu de Cells dans la ligne en dessous
Set foundCell = .Range('F:F').Find(What:=strSearchString, LookIn:=xlValues, LookAt:=xlPart)
If Not foundCell Is Nothing Then
loopAddr = foundCell.Address
Do
counter = counter + 1
foundCell.Activate
If countTot = 1 Then
returnValue = MsgBox(' La valeur ' & strSearchString & ' est enregistrée 1 seule fois ', _
vbOKOnly, ' Message ')
Exit Sub
End If
If counter = countTot Then
returnValue = MsgBox(' La valeur ' & strSearchString & ' sélectionnée est la dernière !', _
vbOKOnly, 'Message')
Exit Sub
Else
returnValue = MsgBox(' La valeur ' & strSearchString & ' sélectionnée est la ' _
& counter & ' sur ' & countTot & ' existantes. ' & _
vbLf & ' Voulez vous continuer la recherche ? ', vbYesNo, 'Message')
If returnValue = vbNo Then Exit For
'Range('F:F') au lieu de Cells dans la ligne en dessous
Set foundCell = .Range('F:F').FindNext(After:=foundCell)
End If
Loop While Not foundCell Is Nothing And foundCell.Address <> loopAddr
End If
End With
Next ws
End If
End Sub
Attention, dans ton exemple les variables sont déclarées deux fois et de manière différente ???
 
T

Temjeh

Guest
Merci beaucoup Robert je vais tester plus tard.
Pour ce qui est des variables en double ce que je vais en montant mes applications je recopie souvent des code ici et là sans souvent les comprendre mais je progresse et je suis fier. Pour en venir aux doublons de variable je ne sais pas ou? car je comprend plus ou moins ce code mais je sais qu'il est tres pratique.

Alors encore un grand merci !!!

Temjeh
 
T

Temjeh

Guest
Temjeh écrit:
Merci beaucoup Robert je vais tester plus tard.
Pour ce qui est des variables en double ce que je vais en montant mes applications je recopie souvent des code ici et là sans souvent les comprendre mais je progresse et je suis fier. Pour en venir aux doublons de variable je ne sais pas ou? car je comprend plus ou moins ce code mais je sais qu'il est tres pratique.

Alors encore un grand merci !!!

Temjeh

Très bon j'ai vérifié et c'est parfait..merci encore et bonne soirée

Temjeh
 

Discussions similaires

Réponses
2
Affichages
267
Réponses
7
Affichages
330

Statistiques des forums

Discussions
312 305
Messages
2 087 091
Membres
103 465
dernier inscrit
Ehoarn_src