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

[EXCJPH]

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

 

[vgendron]

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]

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]

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.

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]

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

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]

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 :

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]

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.

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]

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]

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 :

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+

 

[EXCJPH]

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]

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 ?

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

 

[job75]

Bonjour le forum,

@Wayki, je cherche toujours pourquoi ton code de marche pas au boulot avec Excel 365

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

Il peut donc manquer des fichiers.

A+

 

[EXCJPH]

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]

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 :

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)

 

[EXCJPH]

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