Comment faire une boucle dans ma macro de recherche + insertion de ligne

[gwad063]

Bonjour à tous,

J'ai une macro de recherche de valeur qui m'avait été proposé par JP dans le post : https://www.excel-downloads.com/thr...ertion-ligne-a-chaque-valeurs-trouvees.86978/
Cette macro marche parfaitement mais je me suis rendu compte qu'elle ne faisait pas exactement ce que je voulais...
En effet, lorsqu'elle trouve la valeur recherchée, elle insère une ligne en dessous et copie/colle les valeurs correspondantes, et elle passe à la valeur suivante. Mon problème, c'est que la valeur recherchée peut-être plusieurs fois dans mon tableau, donc, il faudrait qu'à chaque fois qu'elle la trouve, elle vienne insérer une ligne pour y mettre les valeurs qui vont biens avant de passer à la valeur suivante.
J'ai essayé de la modifier mais ça marche pas vraiment (la macro qui m'avait été proposé par JP renvoie à une fonction "recherchemot" dont j'ai du mal à comprendre le fonctionnement...
Donc après plusieurs tentatives, je reviens vers vous pour vous demander un peu d'aide...
Merci par avance.

Gwad.

PS : les fichiers sont dans le lien mais n'hésitez pas si besoin d'infos supplémentaires ou de précisions.

 

[skoobi]

Re : Comment faire une boucle dans ma macro de recherche + insertion de ligne

Bonjour,

la valeur recherchée peut-être plusieurs fois dans mon tableau, donc, il faudrait qu'à chaque fois qu'elle la trouve, elle vienne insérer une ligne pour y mettre les valeurs qui vont biens avant de passer à la valeur suivante

pour celà il faut que tu ajoutes "FindNext" à la suite de "Find", voici l'exemple de l'aide:

Cet exemple montre comment rechercher toutes les cellules de la plage A1:A500 qui contiennent la valeur 2, puis remplacer cette valeur par 5.

With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

 

[gwad063]

Re : Comment faire une boucle dans ma macro de recherche + insertion de ligne

Bonjour skoobi,

J'ai tenté ce que tu m'as conseillé :

For Each cel In Sheets(nom_de_la_feuille).Range(plage_recherche)
With Sheets(nom_de_la_feuille).Range(plage_recherche)
Set cel = .Find(valcherche, LookIn:=xlValues, SearchOrder:=xlByRows, lookat:=xlWhole)
If Not cel Is Nothing Then
firstRow = cel.Row
firstAddress = cel.Address
If code_retour = 1 Then recherchemot = cel.Row
If code_retour = 2 Then recherchemot = cel.Address
Do
Set cel = .FindNext(cel)
Loop While cel Is Nothing And cel.Row <> firstRow
Exit Function
End If
End With
Next
recherchemot = 0
End Function

J'ai essayé de le placer à plusieurs endroits, également avec le "cel.adress" mais rien n'y fait (la macro tourne de la même façon).
J'ai également essayé avec "for each lig in sheets(Nom_de_la f...).Range...", afin que la macro cherche dans toute la plage si il ya plusieurs fois la valeur recherchée, mais c'est pas une super idée...

Gwad

 

[gwad063]

Re : Comment faire une boucle dans ma macro de recherche + insertion de ligne

Bonjour skoobi,

J'ai tenté ce que tu m'as conseillé :

For Each cel In Sheets(nom_de_la_feuille).Range(plage_recherche)
With Sheets(nom_de_la_feuille).Range(plage_recherche)
Set cel = .Find(valcherche, LookIn:=xlValues, SearchOrder:=xlByRows, lookat:=xlWhole)
If Not cel Is Nothing Then
firstRow = cel.Row
firstAddress = cel.Address
If code_retour = 1 Then recherchemot = cel.Row
If code_retour = 2 Then recherchemot = cel.Address
Do
Set cel = .FindNext(cel)
Loop While cel Is Nothing And cel.Row <> firstRow
Exit Function
End If
End With
Next
recherchemot = 0
End Function

J'ai essayé de le placer à plusieurs endroits, également avec le "cel.adress" mais rien n'y fait (la macro tourne de la même façon).
J'ai également essayé avec "for each lig in sheets(Nom_de_la f...).Range...", afin que la macro cherche dans toute la plage si il ya plusieurs fois la valeur recherchée, mais c'est pas une super idée...

Gwad

 

[gwad063]

Re : Comment faire une boucle dans ma macro de recherche + insertion de ligne

Bonjour skoobi, bonjour a tous,

Bon, j'ai essayé d'insérer .findnext dans ma macro (plusieurs tentatives, à plusieurs endroits) mais ya rien à faire : elle tourne correctement (quand elle trouve la valeur, elle m'insère une ligne en dessous pour y incrémenter mes valeurs correspondante mais elle ne le fait que pour la 1ère valeur qu'elle trouve, ensuite elle passe à la suivante); pas moyen qu'elle le fasse à chaque fois qu'elle trouve la valeur...

Voilà ce que donne le 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"
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


Là, je suis un peu à court d'idée, si vous avez quelques suggestions...je serai bien preneur...
Milles merci.

Gwad.