Faire une boucle dans ma macro de recherche...

Résolu
Gwad063 Messages postés 23 Date d'inscription lundi 10 décembre 2007 Statut Membre Dernière intervention 25 janvier 2008 - 21 janv. 2008 à 15:00
Gwad063 Messages postés 23 Date d'inscription lundi 10 décembre 2007 Statut Membre Dernière intervention 25 janvier 2008 - 22 janv. 2008 à 11:40
Bonjour à tous,

ça fait quelques jours que je trime pour trouver une solution à mon problème sans y parvenir donc en dernier recours je viens solliciter un peu d'aide de votre part.
Voilà mon problème :
J'ai une macro qui compare 2 feuilles d'un même fichier Excel, respectivement nommée "Transactions BPR" et "Specifiques"; elle compare la colonne A de la feuille "Specifique" à la colonne E de "Transactions BPR". Lorsqu'elle trouve la même valeur, elle vient insérer une ligne dans ma feuille "Transactions BPR" juste en dessous de la ligne où elle a trouvé la même valeur, dans laquelle elle va mettre en colonne A la valeur de la colonne B de "Specifique" et dans les colonnes B, C, D et E, elle va coller respectivement les valeurs des colonnes B,C,D et E de la ligne juste au dessus...
Elle marche bien, mon problème, c'est que dès qu'elle trouve la valeur, elle vient bien m'insérer ma ligne et coller les valeurs qui vont biens, mais elle le fait une fois et ensuite, elle passe à la valeur suivante...
Or, dans ma feuille "Transactions BPR", il peut y avoir plusieurs fois la valeur recherchée donc il faudrait qu'elle le fasse à chaque fois qu'elle trouve cette même valeur avant de passer à la valeur suivante.

Voilà à quoi ressemble mon code :
Option Explicit



'pour chaque rôle de l'onglet "Specifique" trouvée dans "Transactions_BPR"
'Insertion d'une ligne dans "Transactions_BPR" juste après la ligne de la valeur trouvée,
'dans laquel va venir s'incrémentée la transaction spécifique (colonne A), et recopie de l'étape, process, scénario et rôle auquel elle serait susceptible ede correspondre.
'cette ligne va se colorer pour plus de visibilité.




Sub RechercheSpec()
Dim i As Long
Dim cell As Range
Dim lidep1 As Long
Dim NomFeuille1 As String
Dim NomFeuille2 As String
Dim col1 As String
Dim lig As Long
Application.ScreenUpdating = True 'gele l'ecran


lidep1 = 2
col1 = "a"
NomFeuille1 = "Specifiques"
NomFeuille2 = "Transactions BPR"
For i = lidep1 To Sheets(NomFeuille1).Range(col1 & "65536").End(xlUp).Row
    'Appel de la macro "recherchemot" qui est une macro de recherche de valeur...
    lig = recherchemot("e3:e" & Sheets(NomFeuille2).Range("e65536").End(xlUp).Row, Sheets(NomFeuille1).Range(col1 & i), NomFeuille2, 1)
    'si elle trouve la valeur, alors-> insertion de ligne, copie de valeurs en colonne B, C, D et E de la ligne du dessus
    '+ aller chercher la valeur dans la colonne A de "Specifique".
    If lig <> 0 Then
        Sheets(NomFeuille2).Select
        Rows(lig + 1).Select
        Selection.Insert Shift:=xlDown
        Selection.Interior.ColorIndex = 44
        ' en colonne A, la valeur se trouvant en colonne B de la feuille "spécifique";
        '- en colonne B, C, D et E les valeurs des colonnes B, C, D et E de la ligne juste au dessus;
        Range("B" & lig & ":E" & lig).Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("B" & lig + 1).Select
        ActiveSheet.Paste
        Selection.Interior.ColorIndex = 44
        Sheets(NomFeuille1).Select
        Sheets(NomFeuille2).Range("a" & lig + 1) = Sheets(NomFeuille1).Range("B" & i)
    End If
Next i


Application.ScreenUpdating = False 'gele l'ecran


End Sub
'---------------------------------------------------------------------------------------
' Procedure : recherchemot
'=recherchemot(plage_pour la recherche,valeur_cherché,nom_de_la_feuille, code_retour )
' ad plage de recherche
'ad = "a2:" & Sheets("rue").Cells.SpecialCells(xlCellTypeLastCell).Address(0, 0) ' on recherche dans l'ensemble de la feuille
'
'---------------------------------------------------------------------------------------
'
Private Function recherchemot(plage_recherche As String, valcherche As String, nom_de_la_feuille As String, code_retour As Byte)
Dim firstAddress As String
Dim firstRow As String
Dim cel As Range
Dim ligne1 As Long
Dim ligne2 As Long


With Sheets(nom_de_la_feuille).Range(plage_recherche)
     Set cel = .Find(valcherche, LookIn:=xlValues, SearchOrder:=xlByRows, lookat:=xlWhole) ' on recherche ligne par ligne
   'Set c = .Find(valcherche, LookIn:=xlFormulas, SearchOrder:=xlByRows) 'si date
        'Set £c = .Find(dataf, LookIn:=xlValues, MatchCase:=True, _
    SearchOrder:=xlByRows, lookat:=xlWhole)
 If Not cel Is Nothing Then         If code_retour 1 Then recherchemot cel.Row         If code_retour 2 Then recherchemot cel.Address
         Do
         Set cel = .FindNext(cel)
         Loop While recherchemot = 0
         Exit Function
End If
End With
recherchemot = 0
End Function


J'ai fait pas mal de tentative tout azimut. En bleu, la dernière tentative avec une boucle .findnext, mais rien n'y fait : la macro tourne sans faire de boucle.
Si quelqu'un a une solution, je suis preneur parce que là, ça fait quelques heures que je fais du "sur-place et que je suis un peu à court d'idée.
Vraiment merci par avance.

Gwad.

2 réponses

bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 15
21 janv. 2008 à 18:21
Bonjour,

Sub bob()
    Dim DerniereValeur As Long, Celules As Range, MaPlage As Range
    'la ligne suivante permet de rechercher la derniere valeur de la colonne dans la quelle on fait la recherche_
ceci pour limiter la zone de recherche de la boucle for next et donc accelerer le code
    DerniereValeur = Range("E:E").Find("*", , , , xlByRows, xlPrevious).Row
    For Each Celules In Range("E1", Cells(DerniereValeur, 5)) '5 = colonne E
        If Celules.Value = "MaValeur" Then 'ou MaValeur est la valeur rechercher
            Err.Clear
            On Error Resume Next
            Set MaPlage = Union(MaPlage, Celules)
            If Err.Number <> 0 Then Set MaPlage = Celules 'au premier passage la variable MaPlage est vide donc l'union ne fonctionne pas
        End If
    Next
    'shift:XlDown ne marche pas avec cette methode donc ici on utilise Offset
    MaPlage.Offset(1, 0).EntireRow.Insert 'ici on insert toute les lignes en une fois cet a dire que si la valeur recherchée_
 à été trouvée 10 fois les 10 lignes seront decalées et inserées en meme temps
    MaPlage.Interior.ColorIndex = 44
End Sub

Vala, essaye de comprendre comment ca marche pour le placer au bon endroit dans ton code

A+
3
Gwad063 Messages postés 23 Date d'inscription lundi 10 décembre 2007 Statut Membre Dernière intervention 25 janvier 2008
22 janv. 2008 à 11:40
Milles mercis Bigfish,

Je vais tester ça, mais à priori, ça devrait le faire...

Bonne journée.

Gwad.
0
Rejoignez-nous