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?
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
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 modles
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 aprs 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
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 !!