Macro Excel Recherche valeur entre 2 fichier

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
pou pouille

pou pouille

XLDnaute Nouveau
bonjour le forum,
je viens solliciter votre aide pour une macro de recherche, je m'explique:
j'ai 2 fichier appelons les fichierA et fichierB
je souhaiterai a partir de la colonne G du fichierA trouver la meme valeur qui se trouve dans la colonne J du fichierB
La ou ca se complique c'est que la valeur que je cherche est dans ce format par exemple: C1 ou C23 ou MN3 ou MN46 ou Y199... (donc 1 ou 2 lettre suivit de 1,2ou 3 chiffre)
et dans la colonne J elle se retrouve sous le format suivant (je reprend les memes exemples🙂
C______1 ou C_____23 ou MN_____3 ou MN____46 ou Y____199
(les "_" sont des espaces c'est pour mieux visualisé) le principale est que la cellule est composé de 8 caractères.
une foi trouvé la cellule, on se déplace dans la colonne D (toujours du fichierB) ou l'on récupère les caractère jusqu'a la première "," virgule rencontrée.
Pour finalement venir placer ces caractères dans la cellule K du fichierA (meme ligne que celle de départ).
recherche à répeter pour toute les lignes de mon fichierA , donc sans doute une boucle for

Je remercie d'avance toute personne ayant lu jusqu'au bout mon texte, et encore plus ceux qui voudront bien se pencher sur la question.
(je travaille sous Excel 2003, mais cela devrai fonctionner aussi avec 2007, et je précise que ensuite j'intègre ce code dans une très grande macro que j'ai réalisé).
je ne pense pas pouvoir joindre les fichier puisqu'ils contiennent trop de données confidentielles
Merci, Pou Pouille
 
Trier par date Trier par votes
Re : Macro Excel Recherche valeur entre 2 fichier

Bonsoir pou pouille,

Essayez :

Code: 
Sub Bidouille()
Dim F1 As Worksheet, F2 As Worksheet, plage1 As Range, plage2 As Range
Dim cel1 As Range, cel2 As Range, txt As String, pos As Byte
Set F1 = Workbooks("A.xls").Sheets("Feuil1") 'à adapter
Set F2 = Workbooks("B.xls").Sheets("Feuil1")
Set plage1 = F1.Range("G1", F1.Range("G65536").End(xlUp)) 'ou G2
Set plage2 = F2.Range("J1", F2.Range("J65536").End(xlUp)) 'ou J2
For Each cel1 In plage1
  If cel1 <> "" Then
    For Each cel2 In plage2
      If cel1 = Replace(cel2, " ", "") Then
        txt = cel2.Offset(, -6) 'en colonne D
        pos = InStr(txt, ",")
        [COLOR="Red"]txt = Mid(txt, 1, IIf(pos, pos - 1, 99))[/COLOR]
        cel1.Offset(, 4) = txt 'en colonne K
        Exit For
      End If
    Next cel2
  End If
Next cel1
End Sub
Edit : si pas de virgule, au lieu du texte entier, vous voulez peut-être ne rien mettre, alors remplacez le code en rouge par :

txt = Mid(txt, 1, IIf(pos, pos - 1, 0))

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro Excel Recherche valeur entre 2 fichier

bonjour, et merci d'avoir pri le temps de réfléchir à mon problème.
je vien de voir la réponse cette aprem cependant ce matin j'ai essayé de créer la macro avec le peu de connaissances que j'ai en VBA , seulement vous allez vous en appercevoir c'est pas très brillant du point de vu des boucles (mon fichierB contient 1300 lignes et le fichierA au moins 500 donc le nombre max de boucle est de 650 000 ce qui fait rammer pas mal l'ordi ^^).
je poste le code que j'ai crée , et je vai étudier celui que vous avez fait.
merci.
Pou Pouille
Code: 
Sub GPAO()
'
TheFile = Application.ActiveWorkbook.Name
nomenclature = Application.GetOpenFilename("all files(*.xls),*.Xls")
Workbooks.Open Filename:=nomenclature
nomenclature = Application.ActiveWorkbook.Name
Dim codeTOPO_nom As String
Dim codeGPAO As String
Dim codeTOPO_origine As Variant

For i = 1 To Workbooks(TheFile).Sheets(1).[G65000].End(xlUp).Row
'pour chaque repère topo
    codeTOPO_origine = Workbooks(TheFile).Sheets(1).Range("G" & i).Value
    
    For j = 1 To Workbooks(nomenclature).Sheets(1).[J65000].End(xlUp).Row
        codeTOPO_nom = Workbooks(nomenclature).Sheets(1).Range("J" & j).Value
        Do
            codeTOPO_nom = Replace(codeTOPO_nom, " ", "")               'remplace les espaces
        Loop While InStr(codeTOPO_nom, " ")
        If codeTOPO_nom = codeTOPO_origine Then
            If Workbooks(nomenclature).Sheets(1).Range("H" & j).Value <> 1 Then GoTo quantite0
            codeGPAO = Workbooks(nomenclature).Sheets(1).Range("D" & j).Value
            place = InStr(codeGPAO, ",") - 1
            codeGPAO = "§" & Left(codeGPAO, place) & "§"
            Workbooks(TheFile).Sheets(1).Range("K" & i).Value = codeGPAO
            Exit For
        Else: Workbooks(TheFile).Sheets(1).Range("K" & i).Value = "erreur"          '" " & Workbooks(TheFile).Sheets(1).Range("K" & i).Value & " vide "
        End If
quantite0:
    Next j
Next i
Workbooks(nomenclature).Close
End Sub
 
Vote positif 0 Vote négatif
Re : Macro Excel Recherche valeur entre 2 fichier

Bonjour pou pouille,

Je vois dans votre macro que vous ouvrez le 2ème fichier.

Ma macro suppose que les 2 fichiers sont ouverts, mais bien sûr vous pouvez rajouter le code pour l'ouverture (une ligne, mais il faut faire un test pour vérifier que le fichier a bien été ouvert).

A+
 
Vote positif 0 Vote négatif
Re : Macro Excel Recherche valeur entre 2 fichier

j'ai adapter l'ouverture du fichier, votre macro tourne bien mieu que celle que j'ai crée (comme je le pensais le temps de parcourir toute les ligne du tableau est bien trop long).
j'aurai quelques modif à apporter si vous le pouvez??
premièrement je souhaiterais que après le test de la valeur de cellule:
Code: 
If cel1 = Replace(cel2, " ", "") Then
on test si la cellule en H de la meme ligne =0 dans ce cas tester la ligne suivante ( c'est ce que j'ai voulu écrire ici🙂
Code: 
If Workbooks(nomenclature).Sheets(1).Range("H" & j).Value <> 1 Then GoTo quantite0
ensuite je souhaiterai que si la valeur de la cellule J correspond à la recherche et que la valeur en H=1 (ou <> de 0) dans ce cas, lorsque l'on copie la cellule D , on ajoute des guillemets au début et à la fin dans ce genre la : "text"
Code: 
cel1.Offset(, 4) = ""txt"" 'en colonne K
(je sais pas si le doublement des guillemets fonctionne.
merci.
Pou Pouille
 
Vote positif 0 Vote négatif
Re : Macro Excel Recherche valeur entre 2 fichier

Re,

Pas compris si la colonne H est celle du fichier A ou celle du fichier B, alors on fait les 2 :

Si colonne H du fichier A :

Code: 
Sub Bidouille()
Dim F1 As Worksheet, F2 As Worksheet, plage1 As Range, plage2 As Range
Dim cel1 As Range, cel2 As Range, txt As String, pos As Byte
Set F1 = Workbooks("A.xls").Sheets("Feuil1") 'à adapter
Set F2 = Workbooks("B.xls").Sheets("Feuil1")
Set plage1 = F1.Range("G1", F1.Range("G65536").End(xlUp)) 'ou G2
Set plage2 = F2.Range("J1", F2.Range("J65536").End(xlUp)) 'ou J2
For Each cel1 In plage1
  If cel1 <> "" [COLOR="Red"]And cel1.Offset(, 1) <> 0[/COLOR] Then
    For Each cel2 In plage2
      If cel1 = Replace(cel2, " ", "") Then
        txt = cel2.Offset(, -6) 'en colonne D
        pos = InStr(txt, ",")
        txt = [COLOR="red"]"""" &[/COLOR] Mid(txt, 1, IIf(pos, pos - 1, 99)) [COLOR="red"]& """"[/COLOR]
        cel1.Offset(, 4) = txt 'en colonne K
        Exit For
      End If
    Next cel2
  End If
Next cel1
End Sub

Si colonne H du fichier B :

Code: 
Sub Bidouille()
Dim F1 As Worksheet, F2 As Worksheet, plage1 As Range, plage2 As Range
Dim cel1 As Range, cel2 As Range, txt As String, pos As Byte
Set F1 = Workbooks("A.xls").Sheets("Feuil1") 'à adapter
Set F2 = Workbooks("B.xls").Sheets("Feuil1")
Set plage1 = F1.Range("G1", F1.Range("G65536").End(xlUp)) 'ou G2
Set plage2 = F2.Range("J1", F2.Range("J65536").End(xlUp)) 'ou J2
For Each cel1 In plage1
  If cel1 <> "" Then
    For Each cel2 In plage2
      If cel1 = Replace(cel2, " ", "") And [COLOR="red"]cel2.Offset(, -2) <> 0[/COLOR] Then
        txt = cel2.Offset(, -6) 'en colonne D
        pos = InStr(txt, ",")
        txt = [COLOR="red"]"""" &[/COLOR] Mid(txt, 1, IIf(pos, pos - 1, 99)) [COLOR="red"]& """"[/COLOR]
        cel1.Offset(, 4) = txt 'en colonne K
        Exit For
      End If
    Next cel2
  End If
Next cel1
End Sub

PS : au lieu de <> 0 n'est-ce pas <> "" (cellule non vide) ??

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro Excel Recherche valeur entre 2 fichier

Re,
la colonneH du fichier B dsl pour l'oubli 🙂
après test, il s'avère que j'ai oublier un cas qui arrive bien souvent:
si la recherche de la valeur et la case H correspondante ne donne rien, (cela après avoir balayé la plage cel2 en entier), dans ce cas changer la valeur de la cellule J du fichier A:
Code: 
Sub Bidouille()
Dim F1 As Worksheet, F2 As Worksheet, plage1 As Range, plage2 As Range
Dim cel1 As Range, cel2 As Range, txt As String, pos As Byte
Set F1 = Workbooks("A.xls").Sheets("Feuil1") 'à adapter
Set F2 = Workbooks("B.xls").Sheets("Feuil1")
Set plage1 = F1.Range("G1", F1.Range("G65536").End(xlUp)) 'ou G2
Set plage2 = F2.Range("J1", F2.Range("J65536").End(xlUp)) 'ou J2
For Each cel1 In plage1
  If cel1 <> "" Then
    For Each cel2 In plage2
      If cel1 = Replace(cel2, " ", "") And cel2.Offset(, -2) <> 0 Then
        txt = cel2.Offset(, -6) 'en colonne D
        pos = InStr(txt, ",")
        txt = """" & Mid(txt, 1, IIf(pos, pos - 1, 99)) & """"
        cel1.Offset(, 4) = txt 'en colonne K
        Exit For
      [COLOR="Red"]Else cel1.Offset(,3)=1[/COLOR]
      End If
    Next cel2
  End If
Next cel1
End Sub
est-ce la bonne méthode ?
encore merci pour l'aide 🙂
- Edit oui c'est bien <>0 et non 1 (si il y a 1 c'est ok, si il y a 0 c'est pas ok)
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro Excel Recherche valeur entre 2 fichier

Re,

C'est la bonne méthode, et comme 2 points se mettent automatiquement après Else, écrire dans la foulée :

Else: cel1.Offset(, 3) = 1: End If

Edit : mais non, c'est pas bon... Je revois ça.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro Excel Recherche valeur entre 2 fichier

merci , bonne journée 🙂
-Edit oui je m'en suis apperçu il me met des 1 dans chaque lignes en J...
pour l'instant je part sur la piste de refaire une deuxième boucle
Code: 
For Each cel1 In plage1
    Test= tester si le premier caractère de la cellule est un "
    If cel1.Offset(, 4) = """" Then
    cel1.Offset(, 3).Value = 0
    Else: cel1.Offset(, 3).Value = 1
Next cel1
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro Excel Recherche valeur entre 2 fichier

Re,

Voilà la manière de faire :

Code: 
Sub Bidouille()
Dim F1 As Worksheet, F2 As Worksheet, plage1 As Range, plage2 As Range
Dim cel1 As Range, cel2 As Range, txt As String, pos As Byte
Set F1 = Workbooks("A.xls").Sheets("Feuil1") 'à adapter
Set F2 = Workbooks("B.xls").Sheets("Feuil1")
Set plage1 = F1.Range("G1", F1.Range("G65536").End(xlUp)) 'ou G2
Set plage2 = F2.Range("J1", F2.Range("J65536").End(xlUp)) 'ou J2
For Each cel1 In plage1
  If cel1 <> "" Then
    For Each cel2 In plage2
      If cel1 = Replace(cel2, " ", "") And cel2.Offset(, -2) <> 0 Then
        txt = cel2.Offset(, -6) 'en colonne D
        pos = InStr(txt, ",")
        txt = """" & Mid(txt, 1, IIf(pos, pos - 1, 99)) & """"
        cel1.Offset(, 4) = txt 'en colonne K
        [COLOR="Red"]GoTo 1[/COLOR]
      End If
    Next cel2
    [COLOR="red"]cel1.Offset(, 3) = 1[/COLOR]
  End If
[COLOR="red"]1[/COLOR] Next cel1
End Sub

A+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Question Question
Microsoft 365 Macro pour recherche de cellules entre 2 fichiers Excel
Réponses
6
Affichages
78
wDog66
wDog66
L
  • Question Question
Microsoft 365 recherche X lien entre 2 fichiers
Réponses
3
Affichages
228
lilie17
L
raelle76
  • Résolu(e)
Microsoft 365 Formule entre 2 feuilles
Réponses
7
Affichages
66
TooFatBoy
TooFatBoy
T
  • Résolu(e)
XL 2013 Harmoniser valeur de cellules selon 2 variables
Réponses
4
Affichages
188
Thomas75
T
C
  • Question Question
XL 2013 Moyenne de jours entre 2 événements
Réponses
2
Affichages
311
Cattitude
C
S
  • Résolu(e)
XL 2019 formule recherche qui bug
Réponses
4
Affichages
112
Sylvie J
S
G
  • Résolu(e)
Microsoft 365 Recherche avec 2 critères pour non vide et somme
Réponses
5
Affichages
90
gpion
G
H
  • Résolu(e)
XL 2016 Recherche avec conditions
Réponses
3
Affichages
55
sylvanu
sylvanu
C
  • Résolu(e)
XL 2013 Renvoyer 2 dans la cellule
Réponses
2
Affichages
186
candido57
C
D
  • Question Question
XL 2021 Filtre par référence ou macro
Réponses
12
Affichages
89
sylvanu
sylvanu
D
  • Question Question
Microsoft 365 Différence entre la valeur trouvée et 7
Réponses
9
Affichages
194
Lu76Fer
Lu76Fer
richardlion
  • Question Question
XL 2016 graph avec 2 tcd
Réponses
5
Affichages
73
Hecatonchire
H
L
  • Résolu(e)
XL 2021 recherche valeur si une cellule contient un numéro
Réponses
5
Affichages
176
lola18
L
O
  • Résolu(e)
Microsoft 365 Générer une heure aléatoire entre 2 heures données. Mais sans les secondes
Réponses
8
Affichages
350
Olihoes
O
A
  • Question Question
Microsoft 365 recherche multicritère de la valeur suivante
2
Réponses
29
Affichages
1 K
alexga78
A
T
  • Question Question
XL 2019 MFC - valeur en double - mais avec condition
2
Réponses
22
Affichages
338
job75
job75
C
  • Question Question
XL 2010 Recherche de colonne et calcul sur 2 années consécutives
Réponses
0
Affichages
248
CS49
C
F
  • Question Question
XL 2016 Recherche multi classeurs
Réponses
5
Affichages
235
mromain
mromain
O
  • Question Question
XL 2019 erreur de valeur sur formule
2
Réponses
18
Affichages
861
olivier1984
O
T
  • Question Question
XL 2019 dans un tableau ( mise en forme de tableau), 2 couleur pour 1 tableau
Réponses
4
Affichages
78
tuti
T
Retour