Recherche valeur (mot, chaine de caractère)

Bonjour,

Je cherche à créer un programme qui fait une recherche valeur sur deux feuilles différentes d'un classeur. Comment faire ? J'ai vu un programme de la sorte avec Find All mais pas sûr de l'avoir compris. Le "Byref osht as Worksheet" n'est pas fonctionnel. De plus, j'aimerais faire cette comparaison sur les deux feuilles.

Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean
' --------------------------------------------------------------------------------------------------------------
' FindAll - To find all instances of the1 given string and return the row numbers.
' If there are not any matches the function will return false
' --------------------------------------------------------------------------------------------------------------
On Error GoTo Err_Trap
Dim rFnd As Range ' Range Object
Dim iArr As Integer ' Counter for Array
Dim rFirstAddress ' Address of the First Find
' -----------------
' Clear the Array
' -----------------
Erase arMatches
Set rFnd = oSht.Range(sRange).Find(what:=sText, LookIn:=xlValues, lookAt:=xlPart)

If Not rFnd Is Nothing Then
   rFirstAddress = rFnd.Address
   Do Until rFnd Is Nothing
      iArr = iArr + 1
      ReDim Preserve arMatches(iArr)
      arMatches(iArr) = rFnd.Row 'rFnd.Address pour adresse complete ' rFnd.Row Pour N° de ligne
      Set rFnd = oSht.Range(sRange).FindNext(rFnd)
      If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
   Loop
   FindAll = True
Else
' ----------------------
' No Value is Found
' ----------------------
   FindAll = False
End If
' -----------------------
' Error Handling
' -----------------------
Err_Trap:
If Err <> 0 Then
   MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
   Err.Clear
   FindAll = False
   Exit Function
End If
End Function

Sub test()
Dim Test as Variant 
Test = FindAll( arg, arg, arg,arg) 
End Sub

Bonjour,

Pour que findall fonctionne, il faut respecter le type des paramètres.

pour faire la recherche sur 2 feuilles tu appelles 2 fois la fonction.

Sub test()
    Dim liste() As String, plage As String, a
    Dim test As Boolean
    Dim ws As Worksheet
    Sheets("resultats").Cells.Clear
    Set ws = Sheets("feuil1")
   plage = "A1:A100"
'on recherche avril dans feuil1 et feuil2 
    test = FindAll("avril", ws, plage, liste())
'si avril trouve sur feui1 mettre les numéros de ligne en colonne A sur feuille resultats
    If test Then Sheets("resultats").Cells(1, 1).Resize(UBound(liste), 1) = Application.Transpose(liste)
    Set ws = Sheets("feuil2")
    test = FindAll("avril", ws, plage, liste())
'si avril trouve sur feui2 mettre les numéros de ligne en colonne B sur feuille resultats
    If test Then Sheets("resultats").Cells(1, 2).Resize(UBound(liste), 1) = Application.Transpose(liste)
End Sub

Bonjour ! @H204

Merci beaucoup ! Comment faire si je veux qu'en plus les cellules ou les lignes sélectionnées deviennent rouges si la recherche de mot a marché dans les fichiers feuille 1 et feuille 2 ?

bonjour,

voici une adaptation de la fonction findall

Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean
' --------------------------------------------------------------------------------------------------------------
' FindAll - To find all instances of the1 given string and return the row numbers.
' If there are not any matches the function will return false
' --------------------------------------------------------------------------------------------------------------
On Error GoTo Err_Trap
Dim rFnd As Range ' Range Object
Dim iArr As Integer ' Counter for Array
Dim rFirstAddress ' Address of the First Find
' -----------------
' Clear the Array
' -----------------
Erase arMatches
With oSht.Range(sRange)
.Interior.Pattern = xlNone 'reset range's interior color
Set rFnd = .Find(what:=sText, LookIn:=xlValues, lookAt:=xlPart)

If Not rFnd Is Nothing Then
   rFirstAddress = rFnd.Address
   Do Until rFnd Is Nothing
      iArr = iArr + 1
      rFnd.Interior.Color = vbRed 'set interior color to red for found string
      ReDim Preserve arMatches(iArr)
      arMatches(iArr) = rFnd.Row 'rFnd.Address pour adresse complete ' rFnd.Row Pour N° de ligne
      Set rFnd = oSht.Range(sRange).FindNext(rFnd)
      If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
   Loop
   FindAll = True
Else
' ----------------------
' No Value is Found
' ----------------------
   FindAll = False
End If
' -----------------------
' Error Handling
' -----------------------
End With
Err_Trap:
If Err <> 0 Then
   MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
   Err.Clear
   FindAll = False
   Exit Function
End If
End Function

Sub test()
    Dim liste() As String, plage As String, a
    Dim test As Boolean
    Dim ws As Worksheet
    Sheets("resultats").Cells.Clear
    Set ws = Sheets("feuil1")
   plage = "A1:A100"
'on recherche avril dans feuil1 et feuil2
    test = FindAll("avril", ws, plage, liste())
'si avril trouve sur feui1 mettre les numéros de ligne en colonne A sur feuille resultats
    If test Then Sheets("resultats").Cells(1, 1).Resize(UBound(liste) + IIf(LBound(liste) = 0, 1, 0), 1) = Application.Transpose(liste)
    Set ws = Sheets("feuil2")
    test = FindAll("avril", ws, plage, liste())
'si avril trouve sur feui2 mettre les numéros de ligne en colonne B sur feuille resultats
    If test Then Sheets("resultats").Cells(1, 2).Resize(UBound(liste) + IIf(LBound(liste) = 0, 1, 0), 1) = Application.Transpose(liste)
End Sub