XL 2013 Rechercher et modifier la valeur d'une cellule dans tout un classeur

EXCJPH

XLDnaute Nouveau
Bonjour aux experts ! J'ai vraiment besoin de votre aide car suis débutant et c'est un petit mot

J'ai un classeur MODIF.xlsm sans un dossier. Dans ce même dossier se trouvent plusieurs autres classeurs en xls.

Depuis MODIF.xlsm (macro Lance) je souhaite ouvrir successivement (Un par un) chaque classeur.xls pour chercher dans toutes les feuilles

de ces classeurs dont je ne connais pas le nom les cellules qui contiennent la valeur "Ring" et faire le traitement qui suit:

Effacer le contenu des cellules concernées mais aussi le contenu de la cellule juste en dessous, puis enregistrer et passer au classeur suivant.

Voila, si seulement vous pouviez m'aider. Merci déjà à vous

J'ai commencé avec l'ouverture des classeurs un par un mais je bloque sur le traitement.

Sub Lance()
chemin = ThisWorkbook.Path
PC = Dir(chemin & "\*.xls") ' premier fichier

Do While (PC <> "" And PC <> "MODIF.xlsm")

Workbooks.Open Filename:=chemin & "\" & PC

VOTRE PROCEDURE D'AIDE

PC = Dir
Loop
End Sub
 
Solution
Bonjour EXCJPH, le forum,

Il y a encore 2 choses à régler :

- chez moi Dir(chemin & "\*.xls") récupère aussi les fichiers .xlsm, .xlsb...

- cette instruction n'est pas acceptée sur MAC.

Utilisez donc ce fichier (6) avac :
VB:
PC = Dir(chemin & Application.PathSeparator) ' premier fichier
'-----
While PC <> ""
    If PC <> ThisWorkbook.Name And Right(fichier, 4) = ".xls" Then
A+
Bonjour job75 et le Forum
Oui j'avais remarqué ce bug sur le Dir(chemin & "\*.xls"). Votre nouvelle instruction corrige parfaitement ce petit désagrément.
Mon projet, grâce à vous est ficelé. J'avais déjà, en souvenir, il y a longtemps, téléchargé quelques codes issus de votre cerveau comme "DateFin". Je savais bien que votre nom me disait quelque...

vgendron

XLDnaute Barbatruc
Bonjour
est il possible d'avoir un fichier exemple pour voir à quoi ressemble la structure des fichiers à modifier..
est ce que tous les fichiers à modifier sont faits pareils?

pour parcourir toutes les feuilles du classeur actif
for each ws in activeworkbook.sheets
msgbox ws.name
next ws
 

EXCJPH

XLDnaute Nouveau
Bonsoir
Zut, je n'avais pas vu votre réponse alors que je m'arrache les cheveux ! Merci.
Non, les fichiers à mettre à jour ne sont pas identiques. En plus, à chaque fichier ouvert, j'aimerais pouvoir faire 3 recherches. Si trouvées, effacer le contenu des cellules concernées puis enregistrer le classeur et passer au suivant.
Facile à dire mais pour moi compliqué à programmer. Alors SOS et encore merci
A +
 

Wayki

XLDnaute Impliqué
Bonsoir,
La première partie de ton code ne fonctionne pas chez moi, mais si c'est le cas chez toi tant mieux, pas eu le temps d'approfondir.
Voici un code qui devrait fonctionner, à condition que tu n'ai qu'une seule fois le mot ring par feuille.
VB:
Option Compare Text
Sub Lance()
chemin = ThisWorkbook.Path
PC = Dir(chemin & "\*.xls") ' premier fichier
Dim ws As Worksheet, cellule

Do While (PC <> "" And PC <> "MODIF.xlsm")

Workbooks.Open Filename:=chemin & "\" & PC
For Each ws In ActiveWorkbook.Sheets
    
   If Not ws.Cells.Find("Ring") Is Nothing Then
    cellule = ws.Cells.Find("Ring").Address
    ws.Range(cellule).ClearContents
    ws.Range(cellule).Offset(1, 0).ClearContents
   Else
    MsgBox "Ring n'existe pas dans " & _
    ActiveWorkbook.Name & "!" & ws.Name
   End If
Next ws

PC = Dir
Loop
End Sub
A +
 

EXCJPH

XLDnaute Nouveau
Bonjour Wayki,
Énorme Merci pour ton code qui marche nickel et qui traite plus vite que son ombre. Quand la compétence parle, y'a pas photo !
J'ai un peu modifier ta proposition. Oui, il peut y avoir dans chaque fichier traité un maximum de 3 occurrences., pas une de plus Donc, j'ai bouclé 3 fois. Qu'en penses-tu ? En tous cas chez moi ça fonctionne. J'ai aussi ajouté l'enregistrement en automatique.
La cerise sur le gâteau mais je ne sais pas si c'est possible:
Tu remarqueras que la chaine à rechercher est écrite en dur dans ta macro (CHAINE1="Ring")...
Est-il possible de transmettre cette chaine via le classeur maitre qui appelle la macro Lance. Ça permettrait de choisir facilement la chaine à rechercher et d'en changer. J'imagine plus facile à dire qu'à faire...
Voir ta macro dernièrement à jour et légèrement modifiée
Encore merci et bonne journée

Code:
Sub Lance()
Chemin = ThisWorkbook.Path
PC = Dir(Chemin & "\*.xls") ' premier fichier
Dim ws As Worksheet, cellule

Do While (PC <> "" And PC <> "MODIF.xlsm")
Workbooks.Open Filename:=Chemin & "\" & PC
For Each ws In ActiveWorkbook.Sheets

CHAINE1 = "Ring"
CHAINE2 = ""
CHAINE3 = ""
CHAINE4 = ""
CHAINE5 = ""

For N = 1 To 3
   If Not ws.Cells.Find(CHAINE1) Is Nothing Then
    cellule = ws.Cells.Find(CHAINE1).Address
    ws.Range(cellule).ClearContents
    ws.Range(cellule).Offset(1, 0).ClearContents
   'Else
    'MsgBox (CHAINE1 & " n'existe pas dans " & _
    'ActiveWorkbook.Name & "!" & ws.Name)
   End If
Next
Next ws
'Fermer le classeur
    ActiveWorkbook.Close SaveChanges:=True
    ' Fichier suivant
PC = Dir
Loop
End Sub
 

Wayki

XLDnaute Impliqué
Bonjour
Le top du top pour tes variables serait je pense un userform. Mais pas de fichier, pas de chocolat.
Dans le classeur maître, utiliser de A1 à A5 comme "moteur de recherche"
Puis mettre ce code qui devrait fonctionner :
VB:
Sub Lance()
Chemin = ThisWorkbook.Path
PC = Dir(Chemin & "\*.xls") ' premier fichier
Dim ws As Worksheet, cellule, CHAINE As String

Do While (PC <> "" And PC <> "MODIF.xlsm")
Workbooks.Open Filename:=Chemin & "\" & PC
For i = 1 To 5
    With Worksheets(1)
    CHAINE = .Range("A" & i)
    End With

    For Each ws In ActiveWorkbook.Sheets
        For N = 1 To 3
           If Not ws.Cells.Find(CHAINE) Is Nothing And Not CHAINE = "" Then
            cellule = ws.Cells.Find(CHAINE).Address
            ws.Range(cellule).ClearContents
            ws.Range(cellule).Offset(1, 0).ClearContents
           'Else
            'MsgBox (CHAINE & " n'existe pas dans " & _
            'ActiveWorkbook.Name & "!" & ws.Name)
           End If
        Next N
    Next ws
Next i
'Fermer le classeur
    ActiveWorkbook.Close SaveChanges:=True
    ' Fichier suivant
PC = Dir
Loop
End Sub
A +
 

EXCJPH

XLDnaute Nouveau
Bonjour Wayki
Encore merci de ton aide précieuse. Ça marche mais j'ai été obligé d'activer tour à tour les classeurs pour lire la variable du classeur maitre en "A" & i, et passer sur l'autre classeur à traiter. Regarde si tu as le temps. Histoire de transmission de variable...
Qu'en dis tu ? Pour le chocolat, pas grave. Mon fichier n'est que ta macro et les autres classeurs sont quelconques.
Je vais pouvoir chercher plus tard les occurences trouvées.
Ton avis est important pour moi et pour m'améliorer.

VB:
Sub Lance()
Chemin = ThisWorkbook.Path
PC = Dir(Chemin & "\*.xls") ' premier fichier
Dim ws As Worksheet, cellule, CHAINE As String

Do While (PC <> "" And PC <> "MODIF.xlsm")
Workbooks.Open Filename:=Chemin & "\" & PC
For i = 1 To 5
    Workbooks(1).Activate
    With Worksheets(1)
    CHAINE = .Range("A" & i)
    End With
    Workbooks(2).Activate
    For Each ws In ActiveWorkbook.Sheets
        For N = 1 To 3
           If Not ws.Cells.Find(CHAINE) Is Nothing And Not CHAINE = "" Then
            cellule = ws.Cells.Find(CHAINE).Address
            ws.Range(cellule).ClearContents
            ws.Range(cellule).Offset(1, 0).ClearContents
           'Else
            'MsgBox (CHAINE & " n'existe pas dans " & _
            'ActiveWorkbook.Name & "!" & ws.Name)
           End If
        Next N
    Next ws
Next i
'Fermer le classeur
    ActiveWorkbook.Close SaveChanges:=True
    ' Fichier suivant
PC = Dir
Loop
End Sub
 

Wayki

XLDnaute Impliqué
Bonjour,
Bien vu pour les activate j'y avais pas pensé.
Si tu veux que les variables s'inscrive avant ouverture du classeur suffit de décaler le for i et son instruction en début de macro. Attention à décaler le next i à la suite (je sais pas si c'est clair lol)
 

job75

XLDnaute Barbatruc
Bonjour EXCJPH, vgendron, Wayki,

Je pense que votre test Do While (PC <> "" And PC <> "MODIF.xlsm") ne va pas.

Voyez plutôt les fichiers joints et la macro :
VB:
Option Compare Text 'la casse est ignorée

Sub Lance()
Dim chemin$, PC$, source As Range, w As Worksheet, c As Range, R As Range
chemin = ThisWorkbook.Path
PC = Dir(chemin & "\*.xls*") ' premier fichier
Set source = [A1:A5] 'valeurs à rechercher
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
While PC <> ""
    If PC <> ThisWorkbook.Name Then
        With Workbooks.Open(chemin & "\" & PC)
            For Each w In .Worksheets
                For Each c In source
                    If CStr(c) <> "" Then w.Cells.Replace c, "#N/A", xlWhole
                Next c
                Set R = Nothing
                Set R = w.Cells.SpecialCells(xlCellTypeConstants, 16) 'valeurs d'erreur
                R = ""
                R.Offset(1) = ""
            Next w
            .Close True 'enregistre et ferme le fichier
        End With
    End If
    PC = Dir
Wend
End Sub
A+
 

Pièces jointes

  • MODIF.xlsm
    18 KB · Affichages: 8
  • Test.xlsx
    9.5 KB · Affichages: 8

EXCJPH

XLDnaute Nouveau
Bonsoir Wayki et job75, c'est vraiment sympa de vous intéresser à mon problème. Je vais regarder ça au plus vite. En ce moment au taf, c'est la tête dans le guidon....
Wayki: C'est étrange, ton code marche super bien chez moi avec excel 2007 mais au boulot avec Office 365, c'est différent. En fait, le premier fichier traité est le fichier maître Modif.xlsm, comme si il ne savait pas filtrer les fichier esclave ou à tester en xls. Je cheche et si tu as une idée...
job75, merci de ta proposition; je regarde, télécharge et vais tester aussi.
Il faut que j'arrive à une solution portable mais on s'approche grâce à vous. Allez, je m'y mets !
Encore merci pour toute l'aide que vous m'apporter et surtout pour ma progression à comprendre ! Je tenais à vous répondre
 

EXCJPH

XLDnaute Nouveau
Bonjour Wayki et Job75
@Wayki, je cherche toujours pourquoi ton code de marche pas au boulot avec Excel 365 alors que c'est OK chez moi. J'ai même ajouté une condition. Si l'offset de la cellule trouvée est égal à "--", je l'éfface également sinon je ne fais rien. Qu'en penses tu ?
VB:
Sub Lance()
chemin = ThisWorkbook.Path
PC = Dir(chemin & "\*.xls") ' premier fichier
Dim ws As Worksheet, cellule, CHAINE As String

Do While (PC <> "" And PC <> "MODIF.xlsm")
Workbooks.Open Filename:=chemin & "\" & PC
For i = 1 To 5
    Workbooks(1).Activate
    With Worksheets(1)
    CHAINE = .Range("A" & i)
    End With
    Workbooks(2).Activate
    For Each ws In ActiveWorkbook.Sheets
        For N = 1 To 3
           If Not ws.Cells.Find(CHAINE) Is Nothing And Not CHAINE = "" Then
            cellule = ws.Cells.Find(CHAINE).Address
            ws.Range(cellule).ClearContents
                If ws.Range(cellule).Offset(1, 0) = "--" Then
                ws.Range(cellule).Offset(1, 0).ClearContents
                'Else
                'MsgBox (CHAINE & " n'existe pas dans " & _
                'ActiveWorkbook.Name & "!" & ws.Name)
                End If
           End If
        Next N
    Next ws
Next i
'Fermer le classeur
    ActiveWorkbook.Close SaveChanges:=True
    ' Fichier suivant
PC = Dir
Loop
End Sub
@ job75, j'ai bossé également sur votre version intéressante. Je vous avoue que j'ai un peu de mal à saisir la méthode même si petit à petit j'avance. Si très rapidement vous pouviez m'expliquer...
Une question, mais je sens que j'abuse. Est-il possible, comme pour ma dernière modif avec Wayki, d'effacer l'offset de l’occurrence trouvée seulement s'il contient la chaine "--". J'ai essayé mais sans succès. Probablement qu'il me manque les subtilités de votre code.
A vous deux, encore merci de votre aide. Le VBA commence à me plaire sérieusement...Bonne journée
 

EXCJPH

XLDnaute Nouveau
Bonjour le forum,

Bien comprendre que la boucle Do/Loop s'arrête quand on a PC = "MODIF.xlsm"

Il peut donc manquer des fichiers.

A+
Oui mais le code ne devrait traiter que les fichiers xls avec le Dir. C'est la aussi que je bloque. Bien compris ta remarque job75 Wayki. Il doit y avoir une solution. Peut être en déplaçant MODIF.xlsm et d'avoir seulement dans un dossier les fichiers à traiter. Une idée correcte ?
A+
 

job75

XLDnaute Barbatruc
Est-il possible, comme pour ma dernière modif avec Wayki, d'effacer l'offset de l’occurrence trouvée seulement s'il contient la chaine "--".
Il suffit d'ajouter une boucle pour tester :
VB:
Option Compare Text 'la casse est ignorée

Sub Lance()
Dim chemin$, PC$, source As Range, w As Worksheet, c As Range, R As Range
chemin = ThisWorkbook.Path
PC = Dir(chemin & "\*.xls*") ' premier fichier
Set source = [A1:A5] 'valeurs à rechercher
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
While PC <> ""
    If PC <> ThisWorkbook.Name Then
        With Workbooks.Open(chemin & "\" & PC)
            For Each w In .Worksheets
                For Each c In source
                    If CStr(c) <> "" Then w.Cells.Replace c, "#N/A", xlWhole
                Next c
                Set R = Nothing
                Set R = w.Cells.SpecialCells(xlCellTypeConstants, 16) 'valeurs d'erreur
                R = ""
                For Each R In R.Offset(1)
                    If R Like "*--*" Then R = ""
            Next R, w
            .Close True 'enregistre et ferme le fichier
        End With
    End If
    PC = Dir
Wend
End Sub
PS : s'il ne faut traiter que les fichiers .xls remplacer PC = Dir(chemin & "\*.xls*")
par PC = Dir(chemin & "\*.xls") sans l'astérisque)
 

Pièces jointes

  • MODIF(1).xlsm
    18.5 KB · Affichages: 4
  • Test.xlsx
    9.5 KB · Affichages: 2

EXCJPH

XLDnaute Nouveau
Bonjour le Forum,
@ Wayki, @ job75: Merci Wayki et job75 pour vos remarques et vos propositions.
Je travaille sur vos 2 codes en parallèle pour mieux me former.
On résume Le code de Wayki marche super bien depuis que j'ai modifié cette boucle Do/Loop qui s'arrête quand on a PC = "MODIF.xlsm". En fait j'ai juste traité le début à la façon de job75 et laissé le reste de son code. J'ai même compté de le nombre occurrence trouvé. Rien de compliqué. Donc c'est OK. Merci Wayki.
@job75. A vous aussi Grand merci. Çà marche comme sur des roulettes. J'ai fais de nombreux tests et c'est sans failles. Par contre Je n'arrive pas à compter le nombre d’occurrence trouvé (En dehors des "*--*"), celles spécifiées dans la source [A1:A5]. Si vous avez le temps, et si c'est possible, ce serait la cerise sur le gâteau. J'ai cherché mais le nombre renvoyé est incohérent. Inutile de bloquer trop longtemps. Mieux vaut faire appel aux experts et travailler pour comprendre et finaliser ce petit projet. Un jour j'espère pouvoir faire comme vous et aider les autres dans la difficulté !
Bonne journée à tous
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 871
Messages
2 093 102
Membres
105 627
dernier inscrit
jean-marc.brillant