Chercher remplacer

Bonjour tout le monde aujourd'hui j'ai une nouvelle demande à vous soumettre !

Je vais essayé d'être clair, je travail avec une macro déjà existante qui fais pleins de bonne choses cependant mon employeur m'a demander de la modifier, hors je n'ai pas créé cette macro c'est mon ancien collègue qui l'avait fait.

J'ai un classeur qui contient une colonne "Acheteur" dans cette colonne se trouve par exemple BUT EPERNAY, et à côté de cette colonne se trouve la colonne "Code Magasin" avec comme contenue par exemple "E2645", actuellement la colonne "Code Magasin" est remplie à la main (305 colonnes à remplir).

Ma question est la suivante serai se possible d'ajouter dans ma macro qui créer la colonne "Code Magasin", un chercher remplacer grace a une feuille dans le classeur dans laquelle je créerai une colonne "Chercher" et une autre "Remplacer" dans lesquels je renseigne respectivement le nom du magasin (ici la colonne "Acheteur") et son Code Magasin (la colonne "Code Magasin") et je voudrai qu'elle remplisse grâce au nom du magasin dans la colonne "Acheteur" la colonne "Code Magasin" actuellement remplie à la main.

Merci de votre aide tout le monde !

Bonjour

Sans ton classeur ( ou une partie anonymisée) il est difficile de te répondre.

ton pb est apparemment simple à régler à cette condition

Cordialement

FINDRH

Salut Karai,

Tu peux mettre un fichier exemple?

13exemple.zip (46.83 Ko)

Re bonjour, voici donc un fichier "anonymysé" ahah

Ca a l'air tout simple le seul problème est de l'intégrer a ma macro actuelle

edit:

En gros j'aimerai que sa lise la colonne acheteur et que sa remplisse "code magasin" grasse à la feuille nommée "Feuil1"

Bonjour

Ci joint une proposition avec une formule manuelle pour récupérer le code magasin qui marche si toutes les données jointes sont dans le même classeur

Cordialement

FINDRH

16recol.zip (50.58 Ko)

Du coup comment l'intégrer à ma macro qui créé la colonne "code magasin" ? (car a la base elle n'existe pas c'est ma macro qui la créé

Si vous voulez le code de la macro je peux vous le montrer !

Re,

Tiens à intégrer à ta macro:

Sub test()
'remplissage code magasin

Sheets("Classeur excel").Activate

macol = NumCol("Acheteur")
macol2 = NumCol("Code Magasin")

For I = 1 To Sheets("Classeur excel").UsedRange.Rows.Count
    For J = 1 To Sheets("Feuil1").UsedRange.Rows.Count
        If Sheets("Classeur excel").Cells(I, macol).Value = Sheets("Feuil1").Cells(J, 1).Value Then
            Sheets("Classeur excel").Cells(I, macol2).Value = Sheets("Feuil1").Cells(J, 2).Value
        End If
    Next J
Next I
End Sub

Par contre tu feras attention à supprimer les underscore ( _ ) dans les noms de certains magasins ou autres différences (bagnols / cèze vs bagnols sur cèze) sinon la correspondance foire.


Dans la macro:

' Repart BUT
'
' Ajout des commande systŽmatique ˆ un export ABUT
'
' Ver 0.1
'
'   1.1 - Ajout gestion 1, 2 ou 3 modles
Sub Repart()

Dim Export As String
Dim syst As String
Dim current As String

current = ThisWorkbook.Name

'on ouvre le fichier de commande systŽmatique et on le mets ˆ jour
syst = Application.GetOpenFilename("Classeurs Excel (*.xls), *.xls", 1, "Choisir le fichier le fichier de commande systematique", , False)

Workbooks.Open Filename:=syst
syst = ActiveWorkbook.Name

Dim monid, op, mod1, mod2, mod3 As String
Dim Lignefin, I, J, LigMag, macol, macol2 As Integer
Dim magasin As String
RepartForm.Show
op = RepartForm.OPForm.Value
mod1 = RepartForm.mod1form.Value
mod2 = RepartForm.mod2form.Value
mod3 = RepartForm.mod3form.Value

If mod2 = "" And mod3 = "" Then
    nbre = 1
ElseIf mod3 = "" Then
    nbre = 2
Else
    nbre = 3
End If

' rechercher remplacer les op, les modeles et les date de fin d op
macol = NumCol("Nom du produit")

If nbre = 1 Then
    Worksheets("MATRICE 1 MODELE").Activate
    Columns(macol).Replace What:="MODELE1", Replacement:=mod1, LookAt:=xlPart
    masheet = "MATRICE 1 MODELE"
End If
If nbre = 2 Then
    Worksheets("MATRICE 2 MODELES").Activate
    Columns(macol).Replace What:="MODELE1", Replacement:=mod1, LookAt:=xlPart
    Columns(macol).Replace What:="MODELE2", Replacement:=mod2, LookAt:=xlPart
    masheet = "MATRICE 2 MODELES"
End If
If nbre = 3 Then
    Worksheets("MATRICE 3 MODELES").Activate
    Columns(macol).Replace What:="MODELE1", Replacement:=mod1, LookAt:=xlPart
    Columns(macol).Replace What:="MODELE2", Replacement:=mod2, LookAt:=xlPart
    Columns(macol).Replace What:="MODELE3", Replacement:=mod3, LookAt:=xlPart
    masheet = "MATRICE 3 MODELES"
End If

Columns(macol).Replace What:="XXX", Replacement:=op, LookAt:=xlPart

'on retire les double espace dans les magasins
macol = NumCol("Acheteur")
Columns(macol).Replace What:="  ", Replacement:=" ", LookAt:=xlPart
Columns(macol).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, macol).Value = "A/F/C"
macol = NumCol("Acheteur")
' on construit le numŽro de commande avec recherche du code magasin
' on ajoute la date dans la colonne Date de la commande
Lignefin = Application.WorksheetFunction.CountA(Columns(macol))
monid = 1
For I = 2 To Lignefin
    magasin = Cells(I, macol).Value
    magasin = Replace(magasin, "_A", "")
    magasin = Replace(magasin, "_F", "")
    Workbooks(current).Activate
    Sheets("Magasins").Activate
    LigMag = NumLig(magasin)
    If LigMag = 0 Then LigMag = 1
    magasin = Cells(LigMag, 1)
    Workbooks(syst).Activate
    Sheets(masheet).Activate
    Cells(I, 1).Value = "OP" & op & magasin & "SYS" & monid
    macol = NumCol("Date de la commande")
    Cells(I, 2).Value = DateValue(Now)
    monid = monid + 1
Next

Dim LaCol As Integer
Dim LigneF As Long, NouvLig As Long
Dim Wbk As Workbook
Dim Sh As Worksheet

With Workbooks(syst).Worksheets(masheet)           'choix de la feuille
    macol = NumCol("Acheteur")
    LigneF = .Cells(.Rows.Count, macol).End(xlUp).Row
    ' On ouvre le fichier B et on y ajoute les ligne de A aprs l'avoir nettoyŽ
    Export = Application.GetOpenFilename("Classeurs Excel (*.xls), *.xls", 1, "Choisir le fichier d export", , False)
        Set Wbk = Workbooks.Open(Export)
        Set Sh = Wbk.Worksheets(1)

        ' On efface les colonnes prix, prix unitaire
        Sh.Columns(NumCol("prix")).Delete
        Sh.Columns(NumCol("prix unitaire")).Delete
        'Code postal de la facture

         thecol = NumCol("Code postal de la facture")
        Columns(thecol).Select
        Selection.Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(1, thecol).Value = "Code magasin"

        'On ajoute la colonne A/F/C
        macolone = NumCol("Acheteur")
        Columns(macolone).Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(1, macolone).Value = "A/F/C"

        'on ajoute les lignes du fichier A ˆ la fin du fichier B
        LaCol = NumCol("NumŽro de la commande")
        NouvLig = Sh.Cells(Sh.Rows.Count, LaCol).End(xlUp).Row + 1
        .Rows("2:" & LigneF).Copy Sh.Range("A" & NouvLig)
        Set Sh = Nothing
        Set Wbk = Nothing

End With

macol = NumCol("Acheteur")
'On rempli la colonne A/F/C
Lignefin = Application.WorksheetFunction.CountA(Columns(macol))
For I = 2 To Lignefin
    magasin = Cells(I, macol)
    If Left(magasin, 5) = "BUT-A" Then
        Cells(I, macol - 1).Value = "A"
    ElseIf Left(magasin, 5) = "BUT-F" Then
        Cells(I, macol - 1).Value = "F"
    Else
        Cells(I, macol - 1).Value = "Centrale"
    End If
Next
Columns(macol).Replace What:="-A", Replacement:="", LookAt:=xlPart
Columns(macol).Replace What:="-F", Replacement:="", LookAt:=xlPart

dercol = NumCol("Code postal de la facture")
macol = NumCol("SociŽtŽ de la facture")
For I = dercol To macol Step -1
    Columns(I).Delete
Next
SourceSheet = ActiveSheet.Name
colProd = NumCol("Nom du produit")
colQuant = NumCol("QtŽ commandŽe")
Cells.Select
Cells.EntireColumn.AutoFit
Lignefin = Application.WorksheetFunction.CountA(Columns(NumCol("Acheteur")))
Sheets.Add.Name = "Recap"
Cells(1, 1).Value = "Produit"
Cells(1, 2).Value = "QuantitŽ"
For I = 2 To Lignefin
    Sheets(SourceSheet).Activate
    leProduit = Cells(I, colProd)
    laQuantite = Cells(I, colQuant)
    Sheets("Recap").Activate
    laLigne = NumLig1(leProduit)
    If laLigne = O Then
        LaFin = Application.WorksheetFunction.CountA(Columns(1))
        Cells(LaFin + 1, 1).Value = leProduit
        Cells(LaFin + 1, 2).Value = laQuantite
    Else
        Cells(laLigne, 2).Value = Cells(laLigne, 2).Value + laQuantite
    End If
Next
Cells.Select
Cells.EntireColumn.AutoFit

'remplissage code magasin

Sheets("Classeur excel").Activate

macol = NumCol("Acheteur")
macol2 = NumCol("Code Magasin")

For I = 1 To Sheets("Classeur excel").UsedRange.Rows.Count
    For J = 1 To Sheets("Feuil1").UsedRange.Rows.Count
        If Sheets("Classeur excel").Cells(I, macol).Value = Sheets("Feuil1").Cells(J, 1).Value Then
            Sheets("Classeur excel").Cells(I, macol2).Value = Sheets("Feuil1").Cells(J, 1).Value
        End If
    Next J
Next I

Dim Nom As String
Dim today As String

Application.DisplayAlerts = False
Workbooks(syst).Close
today = Replace(DateValue(Now), "/", "_")
Path = "C:\ResultatsMacros\"
If Len(Dir(Path, vbDirectory)) = 0 Then
    MkDir (Path)
End If
Nom = Path & "REPART_" & op & "_" & today & ".xls"
ActiveWorkbook.SaveAs (Nom)
Application.DisplayAlerts = True

Fin:
MsgBox ("Traitement terminŽ")
End Sub

Public Function NumCol(Texte As String) As Integer
On Error GoTo ErrNumCol
NumCol = Rows(1).Find(Texte, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False).Column
Exit Function
ErrNumCol:
    NumCol = 0
End Function
Public Function NumLig(Texte) As Integer
On Error GoTo ErrNumLig
NumLig = Columns(2).Find(Texte, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False).Row
Exit Function
ErrNumLig:
    NumLig = 0
End Function
Public Function NumLig1(Texte) As Integer
On Error GoTo ErrNumLig1
NumLig1 = Columns(1).Find(Texte, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False).Row
Exit Function
ErrNumLig1:
    NumLig1 = 0
End Function

j'ai une erreur d'execution

Erreur d'execution 1004

Alors que c'est une ligne que l'on à pas du tout modifié ni touché

Appuies sur débogage et fais une capture d'écran

Voila voila je vois pas trop le rapport


Je crois que j'avais fais une bourde j'avais enregistré en restant sur la feuil1 donc ca n'exécutait pas le reste de mon code puisque cette feuil1 n'est pas sensé exister !


Le code s'exécute mais ca ne remplie pas

image

Oui ça doit être ça.

Remplace dans cette ligne de code:

Set Sh = Wbk.Worksheets(1)

worksheets(1) pas sheets("le vrai nom de la feuille où il y a la colonne prix")

ça devrait marcher normalement

Ca marche du feu de dieu !!!

Merci a tous c'est résolu !!

super

Rechercher des sujets similaires à "chercher remplacer"