Macro recherche/remplacement

[ironangel]

Bonjour le forum,

Je sollicite encore une fois votre gracieuse aide, qui me permet d'avancer dans mon boulot.
La situation : chaque fichier à un code défini (ex: DA-02386)
dans chaque fichier des informations se recoupent ( des codes identiques)
ex: j'ai 4 fichiers DA-02386/87/88/89, et dans chacun d'eux, on retrouve l'infos "creme"
J'aimerais pouvoir creer une macro qui me permettent, après indication des codes (DA-02386 par ex) d'effectuer une recherche du mot "creme" dans les fiches indiquées et de me le remplacer par le mot "aérosol"

J'ai pensé à un userform pour l'interface, avec par ex, une zone ou on indique les codes, puis une autre le mot recherché et enfin une avec le mot à remplacer.

Est-ce possible? mes connaissances excel ne me permettent pas d'élucider cela

Un grand merci d'avance
Seb

 

[ironangel]

Re : Macro recherche/remplacement

Bonjour,
qqun pour m'accorder un peu de son temps? pour m'aider sur les démarches à suivres car je ne m'y connais pas suffisament?

Merci d'avance

 

[mromain]

Re : Macro recherche/remplacement

bonjour ironangel

vouci une solution sans UF mais qui a l'air de fonctionner :

Sub test()
Dim tableauClasseurs, texteCherche As String, texteRemplace As String, i As Integer, curSheet As Worksheet, tmpWbk As Workbook

' récupérer les classeurs concernés
tableauClasseurs = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx", MultiSelect:=True)
' récupérer le texte à remplacer
texteCherche = CStr(Application.InputBox("texte cherché"))
' récupérer le nouveau texte
texteRemplace = CStr(Application.InputBox("nouveau texte"))

' boucler sur chaque classeur
For i = LBound(tableauClasseurs) To UBound(tableauClasseurs)
    ' ouvrir le classeur
    Set tmpWbk = Application.Workbooks.Open(tableauClasseurs(i))
    ' boucler sur chaque feuille du classeur
    For Each curSheet In tmpWbk.Worksheets
        ' remplacer les deux textes
        curSheet.Cells.Replace what:=texteCherche, replacement:=texteRemplace, lookat:=xlPart
    Next curSheet
    ' sauver et fermer le classeur
    tmpWbk.Close True
Next i
End Sub

a+

 

[ironangel]

Re : Macro recherche/remplacement

Merci mromain de ton aide, je ne sais pas comment je ferais sans toi ;-)

Pourrais tu m'expliquer comment elle marche? je dois la mettre dans un module? dans thisworkbook?
Comment je définis les classeurs dans lesquels la macro doit chercher?

Merci a toi

 

[mromain]

Re : Macro recherche/remplacement

salut,

tu la met dans un module d'un nouveau classeur et tu la lance.
pour sélectionner les "classeur dans lesquels la macro doit chercher", la macro ouvre une boite de dialogue qui permet de sélectionner les fichier (avec la touche Ctrl).

a+

 

[ironangel]

Re : Macro recherche/remplacement

Super, merci mromain, ça marche nickel ;-)
tu fais de l'info dans la vie, tu es programmateur?

A bientot

 

[mromain]

Re : Macro recherche/remplacement

Super, merci mromain, ça marche nickel ;-)
tu fais de l'info dans la vie, tu es programmateur?

A bientot

re,

non, c'est juste que j'adore excel...
par contre, ne dis pas à un "programmeur" que c'est un "programmateur", il risque mal le prendre .

a+

 

[ironangel]

Re : Macro recherche/remplacement

Bonjour le forum, merci mromain pour ton aide précieuse

J'aimerais adapter cette macro a un autre probleme.
Je possède plusieurs fichiers dans lesquels on trouve le même onglet: caisse + palettisation, dans lesquels doit se situer un même tableau
Le but serait d'avoir une interface qui me permettent de remplir tous les onglets des différents fichiers en entrant les infos qu'une seule fois.

J'ai pensé a un fichier dans lequel j'aurais mon tableau, je le remplit et en activant la macro, il m'ouvre une boite de dialogue dans laquelle je choisi les fichiers dans lesquels je souhaite copier le tableau dans l'onglet "caisse et palettisation"

Merci d'avance pour votre aide

PS: en piece jointe le tableau que je souhaite utiliser

 

[ironangel]

Re : Macro recherche/remplacement

Bonjour le forum,

qqun pour m'aider sur ce probleme?

merci d'avance

 

[mromain]

Re : Macro recherche/remplacement

bonjour

voici une solution :

Sub test()
Dim tableauClasseurs, theSheet As Worksheet, i As Integer, tmpWbk As Workbook, nomOnglet As String
nomOnglet = "[B][COLOR=Red]caisse et palettisation[/COLOR][/B]"

' récupérer les classeurs concernés
tableauClasseurs = Application.GetOpenFilename(filefilter:="Fichiers Excel, *.xls; *.xlsx", MultiSelect:=True)


' boucler sur chaque classeur
For i = LBound(tableauClasseurs) To UBound(tableauClasseurs)
    
    ' ouvrir le classeur
    Set tmpWbk = Application.Workbooks.Open(tableauClasseurs(i))
    
    ' si la feuille existe,...
    On Error Resume Next
    ThisWorkbook.Sheets(nomOnglet).Select
    If Err.Number = 0 Then
        '...on la supprime
        Application.DisplayAlerts = False
        ThisWorkbook.Sheets(nomOnglet).Delete
        Application.DisplayAlerts = True
    End If
    On Error GoTo 0
    
    'copier la feuille dans le classeur
    ThisWorkbook.Sheets(nomOnglet).Copy after:=tmpWbk.Sheets(1)
    
    ' sauver et fermer le classeur
    Application.DisplayAlerts = False
    tmpWbk.Close True
    Application.DisplayAlerts = True
Next i
End Sub

a+

 

[ironangel]

Re : Macro recherche/remplacement

Merci mromain pour ton aide ;-)

J'ai juste un petit soucis, c'est qu'en fait ça ne supprime pas l'onglet existant déjà dans la fiche.
ça ajoute un onglet "caisse et palettisation (2)" au lieu de le supprimer, tu aurais une solution pour ce probleme?

Merci d'avance
merci pour ton aide et ton temps
amicalement
seb

 

[mromain]

Re : Macro recherche/remplacement

salut,

j'ai fait le test chez moi et ça fonctionne (ça supprime bien l'onglet).
désolé, mais je ne vois pas d'où ça peut venir.

a+

 

[ironangel]

Re : Macro recherche/remplacement

Salut mromain,

C'est bizarre, j'ai refait le test, les onglets ont bien le meme nom (mais ils ne contiennent pas la meme chose) mais ça ne supprime pas l'ancien, ça met un (2), bizarre?

Merci à toi

 

[ironangel]

Re : Macro recherche/remplacement

Salut mromain,
je sollicite encore ton aide, cette fois-ci pour les 2 macros ci-dessus ;-)
j'aimerais qu'elles s'appliquent à tous les fichiers excels ouvert sur mon ordi et non avoir une phase dans laquelle je choisie les fichiers, est-ce possible??

Merci d'avance
amicalement

 

[mromain]

Re : Macro recherche/remplacement

re,

voici les macros modifiées, par contre, je ne les ai pas testées. Tiens nous au jus...

Sub test()
Dim texteCherche As String, texteRemplace As String, curSheet As Worksheet, tmpWbk As Workbook

' récupérer le texte à remplacer
texteCherche = CStr(Application.InputBox("texte cherché"))
' récupérer le nouveau texte
texteRemplace = CStr(Application.InputBox("nouveau texte"))

' boucler sur les classeurs ouverts
For Each tmpWbk In Application.Workbooks
    ' ne pas traiter ce classeur
    If tmpWbk.Name <> ThisWorkbook.Name Then
        ' ouvrir le classeur
        Set tmpWbk = Application.Workbooks.Open(tableauClasseurs(i))
        ' boucler sur chaque feuille du classeur
        For Each curSheet In tmpWbk.Worksheets
            ' remplacer les deux textes
            curSheet.Cells.Replace what:=texteCherche, replacement:=texteRemplace, lookat:=xlPart
        Next curSheet
    End If
Next tmpWbk
End Sub

Sub test2()
Dim theSheet As Worksheet, tmpWbk As Workbook, nomOnglet As String
nomOnglet = "caisse et palettisation"


' boucler sur les classeurs ouverts
For Each tmpWbk In Application.Workbooks
    ' ne pas traiter ce classeur
    If tmpWbk.Name <> ThisWorkbook.Name Then
    
        ' ouvrir le classeur
        Set tmpWbk = Application.Workbooks.Open(tableauClasseurs(i))
        
        ' si la feuille existe,...
        On Error Resume Next
        ThisWorkbook.Sheets(nomOnglet).Select
        If Err.Number = 0 Then
            '...on la supprime
            Application.DisplayAlerts = False
            ThisWorkbook.Sheets(nomOnglet).Delete
            Application.DisplayAlerts = True
        End If
        On Error GoTo 0
        
        'copier la feuille dans le classeur
        ThisWorkbook.Sheets(nomOnglet).Copy after:=tmpWbk.Sheets(1)
    End If
Next tmpWbk
End Sub

a+