La redondance du recher-remplacer sous excel
yahi
-
yahi -
yahi -
Bonjour,
redondance
voila j'ai 80 fichier xls tous ont cette structure :
date-chaine-agent-heure-libelle(g4)
---------------------------------jack
---------------------------------fera
----------------------------------nadal
----------------------------------shakira
ces libelles se repete dans ces 80 xls et par suite lorsque je veux remplacer ''fera'' par ''fraca'' je dois ouvrir les 80 xls et faire la modif (rechercher-remplacer)
et c'est pénible pour moi.
donc ce que je veux c'est un macro qui permet de remplacer dans ces 80 xls en même temps les fichiers xls sont stocke dans le même dossier.
redondance
voila j'ai 80 fichier xls tous ont cette structure :
date-chaine-agent-heure-libelle(g4)
---------------------------------jack
---------------------------------fera
----------------------------------nadal
----------------------------------shakira
ces libelles se repete dans ces 80 xls et par suite lorsque je veux remplacer ''fera'' par ''fraca'' je dois ouvrir les 80 xls et faire la modif (rechercher-remplacer)
et c'est pénible pour moi.
donc ce que je veux c'est un macro qui permet de remplacer dans ces 80 xls en même temps les fichiers xls sont stocke dans le même dossier.
A voir également:
- La redondance du recher-remplacer sous excel
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Comment calculer la moyenne sur excel - Guide
- Remplacer disque dur par ssd - Guide
- Si ou excel - Guide
1 réponse
Bonjour,
Une piste ?
Créer un nouveau classeur, par exemple Fonction.xls
A partir de ce classeur (sauver dans un autre répertoire) faire appel à l'éditeur de macros et exécuter la modif dans un de tes 80 classeurs.
Ensuite, adapter la macro pour qu'elle travaille sur les 80 classeurs.
Pour cette dernière phase, tu peu mettre le code générer dans un poste suivant et l'ont pourras t'aider pour l'optimiser.
A+
Une piste ?
Créer un nouveau classeur, par exemple Fonction.xls
A partir de ce classeur (sauver dans un autre répertoire) faire appel à l'éditeur de macros et exécuter la modif dans un de tes 80 classeurs.
Ensuite, adapter la macro pour qu'elle travaille sur les 80 classeurs.
Pour cette dernière phase, tu peu mettre le code générer dans un poste suivant et l'ont pourras t'aider pour l'optimiser.
A+
donc je dois executer ce macro sur un classeur apres modifier le macro pour qu'il fait la modif sur ces 80 feuille
donc franchement j'ai besoin de ce macro.
un ami m'a donner cette formule
Sub ModifierLibelle()
'Sources pour le choix du répertoire
'et la boucle sur ses fichiers
'http://silkyroad.developpez.com/VBA/ListView/#LII-I
'http://www.developpez.net/forums/d270516/autres-langages/general-visual-basic-6-vbscript/vbscript/vos-contributions-vbscript/faq-utiliser-boite-dialogue-selection-repertoire/
'déclaration des variables
Dim oShell As Object, strFileName As Object
Dim oFolder As Object
Dim oFolderItem As Object
Dim OldLibelle As String, NewLibelle As String, NomClasseur As String
Dim Trouve As Range
'empêche le rafraichissement de l'écran pour gagner en rapidité
Application.ScreenUpdating = False
'remplissage des variables :
'NomClasseur = comme son nom l'indique... le nom de ce classeur
'OldLibelle = comme son nom l'indique, l'ancien libellé (à remplacer)
'NewLibelle = comme son nom l'indique... le nouveau libellé
NomClasseur = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'on a inscrit l'ancien libellé en D5
OldLibelle = Sheets(1).Range("D5").Value
'on a inscrit le nouveau libellé en D6
NewLibelle = Sheets(1).Range("D6").Value
'test si les libellés (ancien et nouveau) sont bien remplis
If OldLibelle = "" Or NewLibelle = "" Then
'sinon, message à l'utilisateur
MsgBox "Saisie obligatoire en D5 et D6"
'et on ne fait plus rien, on sort de la procédure
Exit Sub
End If
'Ici, partie technique consistant à ouvrir une fenêtre
Set oShell = CreateObject("Shell.Application")
'permettant le choix du répertoire ou se situent les fichiers excel
Set oFolder = oShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&, "c:\")
'en cas d'annulation par l'utilisateur
If oFolder Is Nothing Then
'message d'abandon
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
'boucle sur tous les fichiers du répertoire
'ne tiens pas compte de l'extension donc sur TOUS les fichiers
For Each strFileName In oFolder.Items
'test si :
'1- le fichier est bien un fichier Excel
'oFolder.GetDetailsOf(strFileName, 2) = "Feuille de calcul Microsoft Excel"
'2- le fichier n'est pas celui qui contient la macro (le mien, ce classeur ci)
'And strFileName <> NomClasseur
If oFolder.GetDetailsOf(strFileName, 2) = "Feuille de calcul Microsoft Excel" And strFileName <> NomClasseur Then
'si c'est tout bon, on ouvre le classeur
Workbooks.Open oFolder.ParentFolder.ParseName(oFolder.Title).Path & "\" & strFileName
'début du bloc "dans le classeur qu'on vient d'ouvrir"
With Workbooks(strFileName & ".xls")
'bloc dans la feuille active (en même temps, il n'y a qu'une feuille par classeur...)
With ActiveSheet
'on cherche dans toutes les cellules l'ancien libellé
Set Trouve = .Cells.Find(OldLibelle)
's'il ne s'y trouve pas on fait rien
If Trouve Is Nothing Then
Else
's'il s'y trouve on remplace par le nouveau libellé dans la cellule
'(Trouve = cellule ou on l'a trouvé)
Trouve.Value = NewLibelle
End If
Set Trouve = Nothing
'fin du bloc feuille
End With
'on enregistre les modifs
.Save
'on ferme
.Close
'fin du bloc classeur
End With
End If
Next
End If
'on rétablit le rafraichissement d'écran
Application.ScreenUpdating = True
End Sub