Sub Suivi_des_PO()
Dim i%
Dim h
Dim k
Dim m
Dim o
Dim q
Dim j As Range
Dim l As Range
Dim c As Range
Dim r As Range
Dim d As Range
Dim e As Range
Dim f As Range
Dim g As Range
Dim p As Range
Dim n As Range
Dim bx As Long
Dim Départ As String
Dim Somme&
Dim Somme1&
Dim Somme2&
Dim Zone As Range
Dim Zone1 As Range
Application.ScreenUpdating = False
bx = MsgBox("As-tu vérifié les lignes de production", vbYesNo)
If (bx = 6) Then
Else
Exit Sub
End If
With Worksheets("5-9-12")
'Supprime les colonnes de A,B,D,E,F,G,H,M,S,U,V,W
.Range("A:B,D:D,J:K,M:M,S:S,U:W").Delete
'Supprime toutes les lignes dont les cellules de C ne commence pas par M
If Not AutoFilterMode Then AutoFilterMode = True
.[C1].AutoFilter 3, "<>M*"
Set c = .Range("_FilterDataBase")
c.Offset(1, 0).Resize(c.Rows.Count - 1).SpecialCells(12).Delete Shift:=xlUp
.ShowAllData
'Insertion de colonne
.Columns("D").Insert
.Columns("H").Insert
.Columns("I:T").Insert
.Cells(1, 2) = "Fournisseur"
.Cells(1, 4) = "PO-LG"
.Cells(1, 6) = "Qté Cmdée"
.Cells(1, 8) = "Qtés RCT-PO"
.Cells(1, 9) = "Qté RCT-C3D"
.Cells(1, 10) = "Qté En Transit"
.Cells(1, 11) = "Qté ASN"
.Cells(1, 12) = "Date RCT-PO"
.Cells(1, 13) = "Détail RCT-C3D"
.Cells(1, 14) = "Date RCT-C3D"
.Cells(1, 15) = "Détail du Transit"
.Cells(1, 16) = "Date Prévue-C3D"
.Cells(1, 17) = "Product Line"
.Cells(1, 18) = "CDC FY"
.Cells(1, 19) = "CDC Periode"
.Cells(1, 20) = "DC Arrival Date"
'Concatène C et "-" et S
Set Zone = .Range("C2:C" & .Range("C65536").End(xlUp).Row)
Zone.Offset(0, 1).FormulaR1C1 = "=RC3&""-""&text(RC25,""000"")" 'Formule en colonne D
Zone.Offset(0, 1) = Zone.Offset(0, 1).Value 'On n'en garde que les valeurs
Zone.Offset(0, 250).FormulaR1C1 = "=IF(OR(RC27=""x"",RC27=""X"",RC27=""C""),""c"",RC27)"
Zone.Offset(0, 24) = Zone.Offset(0, 250).Value
Zone.Offset(0, 250).FormulaR1C1 = "=IF(AND(RC6=RC7,RC27=""c""),0,RC6)"
Zone.Offset(0, 251).FormulaR1C1 = "=IF(AND(RC6=RC7,RC27=""c""),0,RC7)"
Zone.Offset(0, 250) = Zone.Offset(0, 250).Value
Zone.Offset(0, 251) = Zone.Offset(0, 251).Value
Zone.Offset(0, 252) = Zone.Offset(0, 252).Value
Zone.Offset(0, 3) = Zone.Offset(0, 250).Value
Zone.Offset(0, 4) = Zone.Offset(0, 251).Value
'Regroupe les fournisseurs Seetat Delta Galil
Zone.Offset(0, 252).FormulaR1C1 = "=IF(LEFT(RC2,6)=""SEETAT"",""SEETAT"",RC2)"
Zone.Offset(0, -1) = Zone.Offset(0, 252).Value
Zone.Offset(0, 253).FormulaR1C1 = "=IF(LEFT(RC2,11)=""DELTA GALIL"",""DELTA GALIL"",RC2)"
Zone.Offset(0, -1) = Zone.Offset(0, 253).Value
Zone.Offset(0, 250).ClearContents
Zone.Offset(0, 251).ClearContents
Zone.Offset(0, 252).ClearContents
Zone.Offset(0, 253).ClearContents
End With
With Sheets("5-17")
'Insertion d'une colonne
.Columns(6).Insert
.Cells(1, 6) = "PO-LG"
.Cells(1, 12) = "Transit"
'Transforme les cellules texte en nombre.
On Error Resume Next
Set Plage = .Range("K2:K" & Range("K2").End(xlDown).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
For Each c In Plage
c = Replace(c, ",", ".")
Next
Plage.NumberFormat = "0"
'Supprime toutes les lignes dont les cellules de E ne commence pas par M
If Not AutoFilterMode Then AutoFilterMode = True
.[E1].AutoFilter 5, "<>M*"
Set d = .Range("_FilterDataBase")
d.Offset(1, 0).Resize(d.Rows.Count - 1).SpecialCells(12).Delete Shift:=xlUp
.ShowAllData
'Concatène E et "-" et H
Set Zone = .Range("E2:E" & .Range("E65536").End(xlUp).Row)
Zone.Offset(0, 1).FormulaR1C1 = "=RC5&""-""&text(RC8,""000"")" 'Formule en colonne F
Zone.Offset(0, 1) = Zone.Offset(0, 1).Value 'On n'en garde que les valeurs
'On calcule le transit.
'Si X = ? ou L <> 0 Remplace par Transit
Set Zone = .Range("X2:X" & Range("X65536").End(xlUp).Row)
Zone.Offset(0, 220).FormulaR1C1 = "=IF(OR(RC24=""?"",RC12<>0),""Transit"",RC24)"
Zone = Zone.Offset(0, 220).Value
Zone.Offset(0, 220).ClearContents
'Si la date d'arrivée du transit est dépasssée de plus de 30 jours,
'on considère le transit réceptionné C3D
Set Zone = .Range("K2:K" & .Range("K65536").End(xlUp).Row).Offset(0, 1)
Zone.FormulaR1C1 = "=IF(AND(RC23<>0,TODAY()- RC41 > 30),0,RC11)"
Zone = Zone.Value
End With
'Affectation de la variable c à la colonne D de la feuille "5-9-12"
Set c = Worksheets("5-9-12").Range("D" & Worksheets("5-9-12").Range("D65536").End(xlUp).Row)
Do While c.Row > 1
'Remise à 0 des compteurs somme à chaque boucle
Somme& = 0
Somme1& = 0
Somme2& = 0
With Worksheets("5-17").Range("F2:F" & Worksheets("5-17").Range("F65536").End(xlUp).Row)
Set d = .Find(c)
If Not d Is Nothing Then
Départ = d.Address
Do
c(2, 1).EntireRow.Insert
c(2, 0) = "N° ASN"
'n° d'ASN
c(2, 1) = d(1, 26)
If c(2, 0) = "N° ASN" Then
c(2, 3) = 0
c(2, 4) = 0
c(2, 5) = 0
c(2, 6) = 0
c(2, 7) = 0
Else
End If
'qt dans l'ASN
c(2, 8) = d(1, 6)
'Qté ouverte
If c(1, 24) = "c" Then
c(1, 3) = c(1, 3) - c(1, 4)
c(1, 4) = 0
Else
End If
'Qté en transit
c(2, 12) = d(1, 7)
'Qté réceptionnée C3D
If c(1, 3) > c(1, 4) And c(2, 10) = "" And c(2, 12) = "" Then
c(1, 6) = c(1, 3) - c(1, 4)
Else
If c(2, 12) <> 0 Then
c(2, 10) = 0
Else
c(2, 10) = c(2, 8)
End If
End If
'Répète le fournisseur
c(2, -1) = c(1, -1)
'Répète le modèle
c(2, -2) = c(1, -2)
'Répète date contractuelle
c(2, 21) = c(1, 21)
'Répète date d'échéance
c(2, 23) = c(1, 23)
'date rct-po
c(2, 9) = d(1, 5)
'date rct-c3d
c(2, 11) = d(1, 19)
'date prévue c3d
c(2, 13) = d(1, 36)
'Somme des RCT-PO
Somme& = d(1, 6) + Somme&
'Somme des réceptions C3D
Somme1& = c(2, 10) + Somme1&
'Somme des quantités en transit
Somme2& = c(2, 12) + Somme2&
Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address <> Départ
End If
End With
'Fait le total de tout (qt dans l'ASN = RCT-PO, Qté réceptionnée C3D, Qté en transit)
c(1, 5) = Somme&
c(1, 6) = Somme1&
c(1, 7) = Somme2&
Set c = c(0, 1)
Loop
Set Zone = Range("C2:C" & Range("C65536").End(xlUp).Row)
Zone.Offset(0, 250).FormulaR1C1 = "=IF(AND(RC8 = 0,RC27=""c""),RC6-RC7,RC9)"
Zone.Offset(0, 6) = Zone.Offset(0, 250).Value
Zone.Offset(0, 250).ClearContents
Set e = Worksheets("5-9-12").Range("A" & Worksheets("5-9-12").Range("A65536").End(xlUp).Row)
Set f = Worksheets("Product_Line").Range("A" & Worksheets("Product_Line").Range("A65536").End(xlUp).Row)
Do While e.Row > 1
With Worksheets("Product_Line").Range("A2:A" & Worksheets("Product_Line").Range("A65536").End(xlUp).Row)
Set f = .Find(e)
If Not f Is Nothing Then
Départ = f.Address
Do
e(1, 17) = f(1, 2)
Set f = .FindNext(f)
Loop While Not f Is Nothing And f.Address <> Départ
End If
End With
Set e = e(0, 1)
Loop
With Worksheets("5-9-12")
.Range("L:L,N:N,P:P").NumberFormat = "dd/mm/yyyy"
.Columns("A:AC").Columns.AutoFit
.Columns("A:AC").HorizontalAlignment = xlCenter
End With
With Worksheets("Calendar")
.Range("B:B").NumberFormat = "dd/mm/yyyy"
End With
'Toute cette partie consiste a ne pas avoir de vide pour le TCD
With Worksheets("5-9-12")
'g = Echéance Contractuelle
Set g = .Range("X" & .Range("X65536").End(xlUp).Row)
'g1 = Date échéance
Set g1 = .Range("Z" & .Range("Z65536").End(xlUp).Row)
End With
With Sheets("Calendar")
Set Plage = .Range("B2:E" & .Range("B65536").End(xlUp).Row)
End With
' VLookup retourne une erreur si ne trouve pas la donnée
On Error Resume Next
Do While g.Row > 1
If g <> "" Then
'Cherche FY en fonction date contractuelle
h = WorksheetFunction.VLookup(g, Plage, 3, True)
'Cherche Période en fonction date contractuelle
k = WorksheetFunction.VLookup(g, Plage, 4, True)
'Cherche Période en fonction date échéance
k1 = WorksheetFunction.VLookup(g1, Plage, 4, True)
If Err.Number = 0 Then
g(1, -5) = h
g(1, -4) = k
g1(1, -5) = k1
End If
Err.Clear
End If
Set g = g(0, 1) ' Recule d'une ligne
Set g1 = g1(0, 1) ' Recule d'une ligne
Loop
Application.ScreenUpdating = True
End Sub
