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
   |  
Option Explicit
Dim J As Integer 'variable globale index ligne destination
 
'===================================================================================
'
' stFind : Valeur cherchée
'     rOu: Plage de recherche
'
' Retour = Nb de fois trouvé
'
' Modifier procédure TraiteC en fonction
'  du traitement à effectuer...
Function iBoucleCherche(stFind As String, rOU As Range) As Integer
 Dim c As Range
 Dim stAdd As String 'Memo premier element
 Dim bFinBoucle As Boolean
 Dim iNb As Integer
  Set c = rOU.Find(stFind, After:=rOU.Cells(1), LookIn:=xlFormulas, _
  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  MatchCase:=False)
  On Error GoTo 0
  stAdd = c.Address
  bFinBoucle = False
  While Not c Is Nothing And Not bFinBoucle
    iNb = iNb + 1
    TraiteC c
    On Error Resume Next
    Set c = rOU.FindNext(After:=c)
    bFinBoucle = (c.Address = stAdd)
    On Error GoTo 0
  Wend
  iBoucleCherche = iNb
End Function
'
' Fonction de traitement
' A modifier suivant les besoins..
Sub TraiteC(c As Range)
  Debug.Print c.Address & " ... " & c.Value
  '----- le traitement proprement dit...
  ' ici copie ligne entiére dans feuille 2
 
  c.EntireRow.Copy ThisWorkbook.Sheets("Feuil2").Rows(J)
  J = J + 1
End Sub
'=======================================================================================
Sub MonTest()
  J = 1 '
  Debug.Print iBoucleCherche("dupont", ThisWorkbook.Sheets("Feuil1").Cells)
 
End Sub | 
Partager