Rechercher et remplacer

  • Initiateur de la discussion Initiateur de la discussion chrisdu73
  • Date de début Date de début

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 !

chrisdu73

XLDnaute Occasionnel
Bonjour,
J'arrive à rechercher dans une liste et à remplacer, mais je ne parviens pas à le faire si la liste provient d'un autre fichier fermer.
Je voudrais donc en VBA, remplacer le contenu des cellules en colonne G de mon tableau avec la correspondance des cellules identiques en F du fichier parametre.xls par les cellules G
Ci joint un petit fichier exemple avec le résultat attendu.
Merci pour votre aide une fois de plus.

Chris
 

Pièces jointes

Re : Rechercher et remplacer

Bonjour chrisdu73,

Téléchargez les 2 fichiers joints dans le même répertoire (le bureau).

La macro dans Module1 du fichier (1) :

Code:
Sub MAJ()
Dim chemin$, F$, i%, tablo$(1 To 100, 1 To 2) 'hauteur de tablo  à modifier si nécessaire
Dim cel As Range, v As Variant
'---copie les cellules du fichier source---
chemin = "'" & ThisWorkbook.Path 'à adapter éventuellement
F = chemin & "\[Parametre.xls]Feuil1'!R" 'à adapter éventuellement
For i = 2 To 100 'hauteur de tablo
  tablo(i, 1) = ExecuteExcel4Macro(F & i & "C6") 'colonne F
  tablo(i, 2) = ExecuteExcel4Macro(F & i & "C7") 'colonne G
Next
'---mise à jour des cellules---
For Each cel In Range("G2", [G65536].End(xlUp))
  v = Application.VLookup(cel.Text, tablo, 2, 0)
  If Not IsError(v) Then cel = v
Next
End Sub
Le fichier Parametre.xls est étudié sans qu'on l'ouvre...

A+
 

Pièces jointes

Re : Rechercher et remplacer

Re,

Une variante utile sur de grands tableaux : tablo est maintenant un tableau évolutif.

L'étude du fichier source s'arrête quand une cellule vide (ou nulle) est rencontrée en colonne F :

Code:
Sub MAJ()
Dim chemin$, F$, i&, tablo$(), cel As Range, v As Variant
'---copie les cellules du fichier source---
chemin = "'" & ThisWorkbook.Path 'à adapter éventuellement
F = chemin & "\[Parametre.xls]Feuil1'!R" 'à adapter éventuellement
For i = 2 To Rows.Count
  ReDim Preserve tablo(1, i) 'tableau évolutif
  tablo(0, i) = ExecuteExcel4Macro(F & i & "C6") 'colonne F
  tablo(1, i) = ExecuteExcel4Macro(F & i & "C7") 'colonne G
  If tablo(0, i) = 0 Then Exit For '1ère cellule vide (ou nulle)
Next
'---mise à jour des cellules---
Application.ScreenUpdating = False
For Each cel In Range("G2", [G65536].End(xlUp))
  v = Application.HLookup(cel.Text, tablo, 2, 0)
  If Not IsError(v) Then cel = v
Next
End Sub
Nota : seule la dernière dimension de tablo (la largeur) peut être modifiée.

C'est donc maintenant Application.HLookup qui est utilisée.

Fichier (2).

A+
 

Pièces jointes

Re : Rechercher et remplacer

Merci job75 pour ton aide précieuse, je réussi à faire tourner le code dans l'exemple, mais une fois importé à l’intérieur de mon code j'ai une "erreur d’exécution 1004" quand la ligne tablo(0, i) = ExecuteExcel4Macro(F & i & "C6") 'colonne F s'exécute.
Je trouve pas pourquoi et impossible de transférer le code entier car très long.
Donc je suis toujours bloqué.
 
Re : Rechercher et remplacer

Bonjour chrisdu73,

Sans code ni fichier difficile de vous aider 🙂

Dans la macro du post #3 peut-être mettre le 0 entre guillemets ici :

If tablo(0, i) = "0" Then Exit For '1ère cellule vide (ou nulle)

Ou alors il n'y aurait pas de cellules vides en colonne F du fichier Parametre.xls ???

Vérifiez quand même avec =ESTVIDE(cellule)

A+
 
Re : Rechercher et remplacer

Re,

Dans le fichier Parametre.xls j'ai rempli toute la plage F12:F65536 avec la valeur '1101.

Au bout d'une minute j'ai le message :

Excel ne peut pas terminer cette tâche avec les ressources disponibles. Sélectionnez moins de données ou fermez des applications.

Puis erreur 1004. Cela se produit pour i = 16377.

Sur mon ordi (XP/Excel 2003) on ne peut donc aller au-delà.

A+
 
Re : Rechercher et remplacer

Re,

Les codes de votre post #9 n'ont strictement aucun sens.

Si le fichier Parametre.xls est fermé, impossible de déterminer Derlign avec End(xlUp) !!!

Vous essayez de bricoler mon code sans avoir compris ce qui se passe, libre à vous.

Sans plus d'explications de votre part je ne peux pas vous aider.

A+
 
Re : Rechercher et remplacer

Re,

L'intérêt de tout ce qui précède est de montrer comment travailler sur un fichier source fermé.

Mais si l'on accepte d'ouvrir le fichier source il n'y a aucun problème :

Code:
Sub MAJ()
Dim Wb As Workbook, tablo, cel As Range, v As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier source est déjà ouvert
'---ouvre le fichier source---
Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Parametre.xls") 'à adapter éventuellement
'---copie les colonnes F:G du fichier source---
With Wb.Sheets("Feuil1") 'feuille à adapter éventuellement
  tablo = .Range("F2:G" & .[F65536].End(xlUp).Row)
End With
'---ferme le fichier source---
Wb.Close False
'---mise à jour des cellules---
For Each cel In Range("G2", [G65536].End(xlUp))
  v = Application.VLookup(cel.Text, tablo, 2, 0)
  If Not IsError(v) Then cel = v
Next
End Sub
Fichier (3).

A+
 

Pièces jointes

Re : Rechercher et remplacer

Encore un grand merci job75, grâce à votre aide j'ai pu comprendre certaines choses.
Je m’étais effectivement rendu compte de l'erreur
Derlign = Range("F65536").End(xlUp).Row
For y = 2 To Derlign
mais l'erreur 1004 provenait de la variable du chemin, alors j'ai contourné avec un ActiveWorkbook.path.
Et aussi un grand merci au Forum, avec qui sans lui, on oserai même pas s'aventurer dans de si belle aventure.
Merci à tous
 
- 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

  • Question Question
Microsoft 365 Power Query
Réponses
7
Affichages
402
Réponses
8
Affichages
463
Retour