macro pour recherche verticale d'une string1 dans une string2 avec InStrRésolu

Question

Bonjour, Je m'excuse d'avance car je suis surrement en train de construire une macro qui existe déjà, cependant avec mon vocabulaire de débutant, je n'arrive pas à mettre la main dessus... Voici mon challenge: Je cherche à regroupper deux DB qui ne sont pas de clés communes. L'objectif est de consolider la première (Sheet1) en retrouvant des données manquantes qui se trouve (peut etre) dans la deusième DB (Sheet2). Voici la macro que j'ai commencée à écrire mais étant débutant je galère un peu à corriger mes erreurs de syntax, je suis en recherche d'une ame charitable qui pouvait prendre quelques minutes pour étudier cette macro: J'ai cherché à joindre l'excel mais je trouve pas comment faire ! Merci d'avance, Renaud Sub essai() 'i comme variable du loop principal sur la première feuille 'début du loop principal For i = 4 To 5 'mise à zéro de la variable l l = 0 'loop de recherche dans la seconde feuille (colonne K : descrizione prodotto) For j = 1 To 10 'mise à zéro de la variable fl fl = 0 'controle de la presence de la string recherchée de la colonne E 'sr pour string recherchée sr = Sheets("DATI BASE REP 40").Range("E" & CStr(i)) 'sd pour string de la descrizione prodotto sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 'si la string est présente, j'ajoute un point à la note de fiabilité de la ligne If exists Then fl = fl + 1 'copier/coller du code pour le controle de la presence de la string recherchée de la colonne F, G, H sr = Sheets("DATI BASE REP 40").Range("F" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("G" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("H" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 'maintenant j'ai la note de fiabilité de la ligne étudiée fl 'si elle est supérieur à la note de fiabilité la plus élévé trouvée précedemment 'l (variable de la ligne qui à la meilleur note de fiabilité) prend la valeur de j If fl > f Then l = j Next 'ça loope sur toute la feuille 'maintenant que j'ai trouvé la ligne qui a le plus de fiabilité, 'je copie le code produit Worksheets("Anagrafica Base 40").Select Range("I" & CStr(l)).Select Selection.Copy Worksheets("DATI BASE REP 40").Select Range("B" & CStr(i)).Select ActiveSheet.Paste 'coller de la valeur de la varible j j.Copy Worksheets("DATI BASE REP 40").Select Range("A" & CStr(i)).Select ActiveSheet.Paste 'et je rebloucle sur le loop principal pour étudier une nouvelle ligne. Next End Sub

NHenry · Accepted Answer

Bonjour, 

Question d'écriture et d'optimisation :
Sheets("DATI BASE REP 40").Range("E" & CStr(i))
Sheets("Anagrafica Base 40").Range("K" & CStr(j))

Comme tu appelles les feuilles souvent, conserver une référence vers celle-ci serait plus efficace et plus lisible.

Dim lShtSrc As WorkSheet
Dim lShtDst As WorkSheet
set lShtSrc = Sheets("DATI BASE REP 40")
set lShtDst = Sheets("Anagrafica Base 40")

Ensuite, pour l'usage, un simple :
lShtSrc.Range(...)

Utiliser Range est aussi gourmand, tu peux utiliser Cell :
MaFeuille.Cell(Ligne,Colonne)

Et si tu veux vraiment optimiser, il y a aussi de travailler sur un tableau dynamique :
Dim MonTab As Variant
MonTab=MaFeuille.Range("A1:C10") 'A adapter à tes besoins bien entendu.

Penses aussi à utiliser le pas à pas et espionner les valeurs des variables.

As-tu mis Option Explicit en haut de ton code ?
Où est déclaré i et j par exemple ?

Pour aller plus loin, quel est l'effet constaté/désiré ?

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS et aussi ce lien[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site

ucfoutu · Answer

Bonjour,

Commence s'il te plait par indenter ton code et à le présenter ici entre balises code, afin que l'on puisse le lire sans attraper un torticolis 
Merci de bien vouloir faire cet effort.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

NHenry · Answer

Bonjour, 

En complément de ucfoutu :
Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )

---
Mon site

cs_rotex · Answer

Veuillé excuser mon manque d'expérience, voilà le code avec la coloration syntaxique : Sub essai() 'i comme variable du loop principal sur la première feuille 'début du loop principal For i = 4 To 5 'mise à zéro de la variable l l = 0 'loop de recherche dans la seconde feuille (colonne K : descrizione prodotto) For j = 1 To 10 'mise à zéro de la variable fl fl = 0 'controle de la presence de la string recherchée de la colonne E 'sr pour string recherchée sr = Sheets("DATI BASE REP 40").Range("E" & CStr(i)) 'sd pour string de la descrizione prodotto sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 'si la string est présente, j'ajoute un point à la note de fiabilité de la ligne If exists Then fl = fl + 1 'copier/coller du code pour le controle de la presence de la string recherchée de la colonne F, G, H sr = Sheets("DATI BASE REP 40").Range("F" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("G" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("H" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 'maintenant j'ai la note de fiabilité de la ligne étudiée fl 'si elle est supérieur à la note de fiabilité la plus élévé trouvée précedemment 'l (variable de la ligne qui à la meilleur note de fiabilité) prend la valeur de j If fl > f Then l = j Next 'ça loope sur toute la feuille 'maintenant que j'ai trouvé la ligne qui a le plus de fiabilité, 'je copie le code produit Worksheets("Anagrafica Base 40").Select Range("I" & CStr(l)).Select Selection.Copy Worksheets("DATI BASE REP 40").Select Range("B" & CStr(i)).Select ActiveSheet.Paste 'coller de la valeur de la varible j j.Copy Worksheets("DATI BASE REP 40").Select Range("A" & CStr(i)).Select ActiveSheet.Paste 'et je rebloucle sur le loop principal pour étudier une nouvelle ligne. Next End Sub

ucfoutu · Answer

Si c'est là, ta manière d'indenter un code, nous voilà bien !
Tu as utilisé, certes, les balises code, mais ... sur un code non indenté et aussi peu lisible, donc, que ce qu'il était sans ces balises.
Indenter est l'une des toutes premières choses à apprendre, lorsque l'on veut écrire du code.
Ce n'est pas du "luxe", mais une vraie nécessité.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

cs_rotex · Answer

Voici une tentative d'identation. Etant novice en VBA, j'aurais surrement du commencer par plus simple... Je vous suis reconnaissant pour le temps que vous accordez à ma requète. Renaud Sub essai() 'i comme variable du loop principal sur la première feuille 'début du loop principal For i = 4 To 5 'mise à zéro de la variable l l = 0 'loop de recherche dans la seconde feuille (colonne K : descrizione prodotto) For j = 1 To 10 'mise à zéro de la variable fl fl = 0 'controle de la presence de la string recherchée de la colonne E 'sr pour string recherchée sr = Sheets("DATI BASE REP 40").Range("E" & CStr(i)) 'sd pour string de la descrizione prodotto sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 'si la string est présente, j'ajoute un point à la note de fiabilité de la ligne If exists Then fl = fl + 1 'copier/coller du code pour le controle de la presence de la string recherchée de la colonne F, G, H sr = Sheets("DATI BASE REP 40").Range("F" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("G" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("H" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) exists = InStr(sb, sr) <> 0 If exists Then fl = fl + 1 'maintenant j'ai la note de fiabilité de la ligne étudiée fl 'si elle est supérieur à la note de fiabilité la plus élévé trouvée précedemment 'l (variable de la ligne qui à la meilleur note de fiabilité) prend la valeur de j If fl > f Then l = j Next 'ça loope sur toute la seconde feuille 'maintenant que j'ai trouvé la ligne qui a le plus de fiabilité, 'je copie le code produit Worksheets("Anagrafica Base 40").Select Range("I" & CStr(l)).Select Selection.Copy Worksheets("DATI BASE REP 40").Select Range("B" & CStr(i)).Select ActiveSheet.Paste 'coller de la valeur de la varible j j.Copy Worksheets("DATI BASE REP 40").Select Range("A" & CStr(i)).Select ActiveSheet.Paste 'et je rebloucle sur le loop principal pour étudier une nouvelle ligne. Next End Sub

ucfoutu · Answer

1) Je souscris totalement à ce qu'a exprimé NHenry et, comme lui, t'engage à : - travailler autrement (sur des tableaux dynamiques, par exemple) - nous exposer de manière précuise les tenants et aboutissants 2)Voici une tentative d'identation. L'indentation a pour but de permettre une bonne visibilité, ce qui n'est toujours pas le cas malgré tes efforts. Regarde : je reprends ton code (ce qui ne préjuge pas, loin de là, que je l'approuve ! C'est uniquement pour que tu comprennes ce qu'est une indentation logique) : Sub essai() 'i comme variable du loop principal sur la première feuille 'début du loop principal For i = 4 To 5 'mise à zéro de la variable l l = 0 'loop de recherche dans la seconde feuille (colonne K : descrizione prodotto) For j = 1 To 10 'mise à zéro de la variable fl fl = 0 'controle de la presence de la string recherchée de la colonne E 'sr pour string recherchée sr = Sheets("DATI BASE REP 40").Range("E" & CStr(i)) 'sd pour string de la descrizione prodotto sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) Exists = InStr(sb, sr) <> 0 'si la string est présente, j'ajoute un point à la note de fiabilité de la ligne If Exists Then fl = fl + 1 'copier/coller du code pour le controle de la presence de la string recherchée de la colonne F, G, H sr = Sheets("DATI BASE REP 40").Range("F" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) Exists = InStr(sb, sr) <> 0 If Exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("G" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) Exists = InStr(sb, sr) <> 0 If Exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("H" & CStr(i)) sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) Exists = InStr(sb, sr) <> 0 If Exists Then fl = fl + 1 'maintenant j'ai la note de fiabilité de la ligne étudiée fl 'si elle est supérieur à la note de fiabilité la plus élévé trouvée précedemment 'l (variable de la ligne qui à la meilleur note de fiabilité) prend la valeur de j If fl > f Then l = j Next 'ça loope sur toute la seconde feuille 'maintenant que j'ai trouvé la ligne qui a le plus de fiabilité, 'je copie le code produit Worksheets("Anagrafica Base 40").Select Range("I" & CStr(l)).Select Selection.Copy Worksheets("DATI BASE REP 40").Select Range("B" & CStr(i)).Select ActiveSheet.Paste 'coller de la valeur de la varible j j.Copy Worksheets("DATI BASE REP 40").Select Range("A" & CStr(i)).Select ActiveSheet.Paste 'et je rebloucle sur le loop principal pour étudier une nouvelle ligne. Next End Sub Observe quel point il est maintenant facile de distinguer chaque "bloc" (une boucle for ? c'est un "bloc" jusqu'au next qui la concerne. Une condition If ? C'est un "bloc" jusqu'au End If qui la concerne, etc ...) ____________________ Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs. Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

us_30 · Answer

Bonjour, Il y a encore pas mal de chose qui ne tourne pas dans le code. 1ère chose : Les déclarations : Tu devrais plutôt écrire comme ceci le début : Option Explicit Sub essai() ' Paramètres Dim i As Long Dim j As Long Dim l As Long Dim fl As Long Dim Exists As Boolean Dim Sr As Worksheet Dim Sd As Worksheet 2ième chose : Le test Instr Exists = InStr(sb, sr) <> 0 devrait plutôt être : Exists = (InStr(Sd, Sr) <> 0) c'est à dire avec les parenthèses et les deux variables à tester Sd et sb ! 3ième chose : Supprimer les lignes inutiles "sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j))" Ce sont toujours la même référence ! 4ième chose : Le test : If fl > f Then l = j n'a aucun sens. "f" n'est jamais défini. Puis, l n'est jamais utilisé. Il y a un problème de logique dans ce test, dans la façon dont il est placé et construit. 5ième chose : 'coller de la valeur de la varible j j.Copy Worksheets("DATI BASE REP 40").Select Range("A" & CStr(i)).Select ActiveSheet.Paste peut s'écrire bcp plus simplement : Worksheets("DATI BASE REP 40").Range("A" & CStr(i)).Value = j Voilà quelques pistes... Au total, ton code se résume ainsi (sans prendre en compte le côté fonctionnel et pouvant encore s'améliorer) Option Explicit Sub essai() ' Paramètres Dim i As Long Dim j As Long Dim l As Long Dim fl As Long Dim Exists As Boolean Dim Sr As Worksheet Dim Sd As Worksheet ' Boucle de recherche For i = 4 To 5 l = 0 For j = 1 To 10 ' Passage des données fl = 0 Sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) ' Recherche dans DATI Sr = Sheets("DATI BASE REP 40").Range("E" & CStr(i)) Exists = (InStr(Sd, Sr) <> 0) ' Test existance de la presence de la string recherchée If Exists Then fl = fl + 1 'si la string est présente, j'ajoute un point à la note de fiabilité de la ligne Sr = Sheets("DATI BASE REP 40").Range("F" & CStr(i)) Exists = (InStr(Sd, Sr) <> 0) If Exists Then fl = fl + 1 Sr = Sheets("DATI BASE REP 40").Range("G" & CStr(i)) Exists = (InStr(Sd, Sr) <> 0) If Exists Then fl = fl + 1 Sr = Sheets("DATI BASE REP 40").Range("H" & CStr(i)) Exists = (InStr(Sd, Sr) <> 0) If Exists Then fl = fl + 1 If fl > f Then l = j ' ??? f n'est pas défini ! Next j 'ça loope sur toute la seconde feuille 'maintenant que j'ai trouvé la ligne qui a le plus de fiabilité, 'je copie le code produit Worksheets("Anagrafica Base 40").Range("I" & CStr(l)).Select Selection.Copy Worksheets("DATI BASE REP 40").Range("B" & CStr(i)).Select ActiveSheet.Paste 'coller de la valeur de la varible j Worksheets("DATI BASE REP 40").Range("A" & CStr(i)).Value = j Next i End Sub Amicalement, Us.

us_30 · Answer

En plus :

6ième chose :
Worksheets("Anagrafica Base 40").Range("I" & CStr(l)).Select
       Selection.Copy
       Worksheets("DATI BASE REP 40").Range("B" & CStr(i)).Select
       ActiveSheet.Paste
s'écrit plus simplement :
Worksheets("Anagrafica Base 40").Range("I" & CStr(l)).Value = Worksheets("DATI BASE REP 40").Range("B" & CStr(i)).Value

Amicalement,
Us.

us_30 · Answer

On peut encore condenser le code...  mais il faudrait qu'il soit fonctionnel avant tout... 

A+
Us.

cs_rotex · Answer

Bonsoir, Après quelques petites modifications le code fonctionne ! J'imagine que le code est perfectible mais je essayé de l'améliorer seul. Je tiens à remercier toutes les personnes qui ont contribuées à la réalisation de cette macro. Bonne continuation et encore merci pour le coup de main !!! Renaud Sub essai() ' Paramètres Dim i As Long Dim j As Long Dim l As Long Dim fl As Long Dim f As Long Dim Exists As Boolean Dim sd As String Dim sr As String ' Boucle de recherche For i = 355 To 1500 f = 0 l = 0 For j = 2 To 1271 ' Passage des données fl = 0 sd = Sheets("Anagrafica Base 40").Range("K" & CStr(j)) ' Recherche dans DATI sr = Sheets("DATI BASE REP 40").Range("E" & CStr(i)) Exists = (InStr(sd, sr) <> 0) ' Test existance de la presence de la string recherchée If Exists Then fl = fl + 1 'si la string est présente, j'ajoute un point à la note de fiabilité de la ligne sr = Sheets("DATI BASE REP 40").Range("F" & CStr(i)) Exists = (InStr(sd, sr) <> 0) If Exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("G" & CStr(i)) Exists = (InStr(sd, sr) <> 0) If Exists Then fl = fl + 1 sr = Sheets("DATI BASE REP 40").Range("H" & CStr(i)) Exists = (InStr(sd, sr) <> 0) If Exists Then fl = fl + 1 If fl > f Then l = j If fl > f Then f = fl Next j 'ça loope sur toute la seconde feuille 'maintenant que j'ai trouvé la ligne qui a le plus de fiabilité, 'je copie le code produit et coller de la valeur de la varible j If l <> 0 Then Worksheets("DATI BASE REP 40").Range("B" & CStr(i)).Value = Worksheets("Anagrafica Base 40").Range("I" & CStr(l)).Value If l <> 0 Then Worksheets("DATI BASE REP 40").Range("A" & CStr(i)).Value = f If l 0 Then Worksheets("DATI BASE REP 40").Range("B" & CStr(i)).Value "Not found" Next i End Sub

us_30 · Answer

Bonjour, Déjà si ça marche, c'est déjà ça... Ensuite, quelques encore remarques pour le fun : Les tests : If fl > f Then l = j If fl > f Then f = fl sont identiques, donc les condenser en un seul, non ? If fl > f Then l = j f = fl End If La même remarque s'applique à : If l <> 0 Then Worksheets("DATI BASE REP 40").Range("B" & CStr(i)).Value = Worksheets("Anagrafica Base 40").Range("I" & CStr(l)).Value If l <> 0 Then Worksheets("DATI BASE REP 40").Range("A" & CStr(i)).Value = f Et je te laisse trouvé comment faire... c'est un petit exercice qui noté ! Amicalement, Us.

us_30 · Answer

lire :
"qui sera noté"

Us.

Macro pour recherche verticale d'une string1 dans une string2 avec InStr

13 réponses

Votre réponse

Discussions similaires