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
Dim arTemp() As String 'Temp Array Dim bFound As Boolean 'Flag Dim ChercheX As String Dim ma_plage As String bFound = FindAll(ChercheX, Sheets(Nom_Feuil), ma_plage, arTemp()) ' ChercheX = valeur cerhchée ' Sheets(Nom_Feuil) = feuille où effectuer la recherche ' ma_plage : Plage de cellules ou rechercher ' arTemp() = tableau qui contiendra la liste des coordonnées (N° de lignes ) If bFound = True Then For X = 1 To UBound(arTemp) Msgbox UBound(x) Next Else Msgbox "Aucune valeur trouvée" End If
Private Sub nom_Change() Dim arTemp() As String 'Temp Array Dim bFound As Boolean 'Flag Dim ChercheX As String Dim ma_plage As String Dim Nom_Feuil as String ChercheX = Me.nom.Value ma_plage = "B6:B200" Nom_Feuil = "Toulouse" bFound = FindAll(ChercheX, Sheets(Nom_Feuil), ma_plage, arTemp()) 'Et ensuite pour afficher les resultats dans ton usf : If bFound = True Then For X = 1 To UBound(arTemp) Me.prenom.value = Sheets(Nom_Feuil).cells(bfound(x),"C").value 'etc... Next Else Msgbox "Aucune valeur trouvée" End If End Sub
Me.prenom.value = Sheets(Nom_Feuil).cells(arTemp(x),"C").value
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question