Fonction RechercheV dans Macro
V
Bonjour,
J'ai besoin d'aide pour retoucher une macro qui marche "presque" bien
Elle va chercher des informations dans 3 fichiers différents pour les regrouper dans un 4Ieme sur 2 feuilles différentes
Mon problème est que la macro ne me donne pas la bonne localisation en fonction du code du produit
Voici la macro en question
Sub MacroInvCyclique2017()
Nom_Fichier = Application.GetOpenFilename("temp loc (*.xlsx), *.xlsx")
If Nom_Fichier <> False Then
Workbooks.Open Filename:=Nom_Fichier
Nom_Fichier2 = Application.GetOpenFilename("temp loc (*.xlsx), *.xlsx")
End If
If Nom_Fichier2 <> False Then
Workbooks.Open Filename:=Nom_Fichier2
Nom_Fichier3 = Application.GetOpenFilename("temp loc (*.xlsx), *.xlsx")
End If
If Nom_Fichier3 <> False Then
Workbooks.Open Filename:=Nom_Fichier3
End If
Set wsc = ThisWorkbook.Sheets("feuil1") ' feuille cumul
Set wsc1 = ThisWorkbook.Sheets("feuil2") ' feuille cumul pour produit sans lot
k1 = 1 ' compteur de ligne sur wsc1
dlc = wsc.Cells(Rows.Count, 1).End(xlUp).Row ' nombre de lignes produit
Set wsloc = Workbooks("Location Fidelio.xlsx").Sheets("Sheet1") ' feuille localisation
dlloc = wsloc.Cells(Rows.Count, 1).End(xlUp).Row 'nombre de lignes localisation
Set rloc = wsloc.Range("A1:A" & dlloc) 'plage de recherche du produit sur localisation
Set wslot = Workbooks("Inv avec lot Fidelio.xlsx").Sheets("Sheet1") ' feuille lot
dllot = wslot.Cells(Rows.Count, 1).End(xlUp).Row 'nombre de lignes lot
Set rlot = wslot.Range("A1:A" & dllot) 'plage de recherche du produit sur lot
' on trie le cumul par numéro de produit
wsc.Range("A1:A" & dlc).Sort key1:=wsc.Range("A1"), order1:=xlAscending, Header:=xlYes
Set wssslot = Workbooks("Inv Fidelio.xlsx").Sheets("Sheet1") 'feuille sans lot
dlsslot = wssslot.Cells(Rows.Count, 1).End(xlUp).Row 'nombre lignes sur sans lot
Set rsslot = wssslot.Range("A1:A" & dlsslot) 'plage de recherche sans lot
With wslot '
'on trie le lot par numéro de produit
.Range("A1:D" & dllot).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
wsc.Range("b2:F1000").ClearContents
wsc1.Range("A2:f1000").ClearContents
i = 2 ' pointeur de ligne sur cumul
While wsc.Cells(i, 1) <> "" ' tant quil y a un numéro de produit
' on recherche le produit dans lot
Set re = rlot.Find(wsc.Cells(i, 1), lookat:=xlWhole, after:=rlot.Cells(1, 1))
If Not re Is Nothing Then 'si trouvé
k = re.Row 'k numéro de ligne du produit dans lot
wsc.Cells(i, 1) = .Cells(k, 1) ' on met le numéro de produit du lot
wsc.Cells(i, 2) = .Cells(k, 2) ' on met la description du lot
' on recherche le produit dans location
Set re = rloc.Find(.Cells(i, 1), lookat:=xlWhole)
If Not re Is Nothing Then 'si trouvé
wsc.Cells(i, 6) = re.Offset(0, 5) 'on met la zone de la location
End If
wsc.Cells(i, 3) = .Cells(k, 13) ' on met n° de lot
wsc.Cells(i, 4) = .Cells(k, 15) 'on met quantité
k = k + 1 'on prend la ligne suivante du lot
While .Cells(k, 1) = .Cells(k - 1, 1) ' on parcourt tous les lots d'un même produit
i = i + 1 'on incrémente compteur de ligne
wsc.Rows(i).Insert shift:=xlDown 'on insère une ligne
wsc.Cells(i, 3) = .Cells(k, 13) 'on met le n° de lot
wsc.Cells(i, 4) = .Cells(k, 15) 'on met quantité
k = k + 1 'on prend la ligne suivante du lot
Wend
i = i + 1 'on prend le produit suivant sur cumul
Else 'on n'a pas trouvé le produit sur lot on recherche sur sans lot
Set re = rsslot.Find(wsc.Cells(i, 1), lookat:=xlWhole)
wsc.Cells(i, 6) = "A vérifier"
wsc.Cells(i, 4) = " Regarder sur Fidelio"
If Not re Is Nothing Then ' on a trouvé le produit sur sans lot
k = re.Row 'n° de ligne du produit
k1 = k1 + 1 'pointeur de ligne sur cumul sans lot
wsc1.Cells(k1, 1) = wsc.Cells(i, 1) ' on copie le numéro de produit
wsc1.Cells(k1, 3) = re.Offset(0, 10) ' on copie la colonne K
' on recherchele produit sur localisation
Set ra = rloc.Find(wsc.Cells(i, 1), lookat:=xlWhole)
If Not ra Is Nothing Then 'si trouvé
wsc1.Cells(k1, 2) = ra.Offset(0, 1) 'on copie description de location
If IsEmpty(ra.Offset(0, 5)) Then wsc1.Cells(k1, 5) = "A vérifier" Else wsc1.Cells(k1, 5) = ra.Offset(0, 5) 'on copie quantité de description
Else
wsc1.Cells(k1, 2) = re.Offset(0, 3) 'on copie quantité de description
wsc1.Cells(k1, 3) = re.Offset(0, 10) ' on copie la colonne K
MsgBox "Localisation non trouvée pour le produit " & wsc.Cells(i, 1)
If IsEmpty(ra.Offset(0, 5)) Then wsc1.Cells(k1, 5) = "A vérifier" Else wsc1.Cells(k1, 5) = ra.Offset(0, 5) 'on copie quantité de description
End If
wsc.Rows(i).Delete shift:=xlUp ' on supprime la ligne de cumul
Else
Set ra = rloc.Find(wsc.Cells(i, 1), lookat:=xlWhole)
i = i + 1
End If
End If
Wend
End With
Workbooks("Location Fidelio.xlsx").Close False
Workbooks("Inv avec lot Fidelio.xlsx").Close False
Workbooks("Inv Fidelio.xlsx").Close False
End SubCi-joint les 3 fichiers qu,il faut ouvrir au début de la macro et le fichier comprenant la macro
Merci beaucoup !!
Vincent