1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
| Public Function FindWord(ByVal sWord As String, Optional vPlage As Variant, Optional wSheet As Variant = "ActiveSheet") As String()
Dim bVerifPlage As Boolean, rStartCell As Range
If Not wSheet = "ActiveSheet" Then Sheets(wSheet).Select
'vérification de la feuille à traiter
If Not IsMissing(vPlage) Then bVerifPlage = True
'vérification d'une possible plage
Dim cMyAddress As New Collection
Dim sRes() As String
Dim ParseRange() As String
If bVerifPlage = False Then
' s'il n'y pas de plage, on vérifie dans toute la feuille
Cells.Find(What:=sWord, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate: cMyAddress.Add ActiveCell.Address
Set rStartCell = ActiveCell
Do
Cells.FindNext(After:=ActiveCell).Activate: cMyAddress.Add ActiveCell.Address
Loop While ActiveCell.Address <> Range(rStartCell).Address
' on place l'adresse des cellules dans un tableau de données
' il sera facile de savoir après quelles cellules contiennent
' les données recherchées. (où même sélectionner ces cellules)
ReDim sRes(cMyAddress.Count - 1)
For i = 0 To cMyAddress.Count - 1
sRes(i) = cMyAddress.Item(i + 1)
Next i
Else
' s'il y pas une plage, on vérifie seulement dedans
Dim rPlage As Range
Set rPlage = vPlage
' on instancie l'objet (plage) en récupérant sa valeur
ParseRange = Split(CStr(rPlage.Address), ":")
' ici je récupère la dernière cellule de recherche, afin de la sélectionner
' comme ça, le résultat sera chronologique (sinon, la recherche s'effectue
' depuis la cellule sélectionnée)
Range(ParseRange(1)).Select
rPlage.Find(What:=sWord, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate: cMyAddress.Add ActiveCell.Address
Set rStartCell = ActiveCell
Do
rPlage.FindNext(After:=ActiveCell).Activate: cMyAddress.Add ActiveCell.Address
Loop While ActiveCell.Address <> Range(rStartCell.Address).Address
' on place l'adresse des cellules dans un tableau de données
' il sera facile de savoir après quelles cellules contiennent
' les données recherchées. (où même sélectionner ces cellules)
ReDim sRes(cMyAddress.Count - 2)
For i = 0 To cMyAddress.Count - 2
sRes(i) = cMyAddress.Item(i + 1)
Next i
End If
FindWord = sRes: Set cMyAddress = Nothing: Erase sRes
End Function
Sub Exemple_Utilisation()
Dim sResult() As String, l As Integer
sResult = FindWord("bonjour", Range("C23:Z114"), "Feuil3")
' autres exemples d'utilisation
'sResult = FindWord("abc", Range("A1:B20"))
'sResult = FindWord(UserForm1.ComboBox1.Text, Range("A1:B20"))
For l = 0 To UBound(sResult)
Debug.Print "-" & sResult(l) & "-"
Next l
Erase sResult
End Sub |
Partager