1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
| Sub Qrepartir()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
'Donne le jour surlequel on peut répartir un produit et le place grâce à la fonction allocQtion
'Contrainte : Priorité Div et Répartition Techno WorkOrder, quota par division et quantité
'Reste à ajouter : stock de silicium
Dim NBa As Double
Dim Division(10) As String
Dim PWO(2), PQuota(2), PTechno(2), PQt(2), Pprio(2) As Double
With Params
PWO(0) = .Range("T39").Value
PWO(1) = .Range("U39").Value
PQuota(0) = .Range("T40").Value
PQuota(1) = .Range("U40").Value
PQuota(2) = .Range("V40").Value
PTechno(0) = .Range("T41").Value
PTechno(1) = .Range("U41").Value
PTechno(2) = .Range("V41").Value
PQt(0) = .Range("T42").Value
PQt(1) = .Range("U42").Value
Pprio(0) = .Range("T43").Value
Pprio(1) = .Range("U43").Value
Pprio(2) = .Range("V43").Value
Quantitemaxparjour = .Range("V45").Value
End With
'On cherche quel jour doit être réparti
feuille = ActiveSheet.Name
jour = 0
j = 1
While jour = 0 And j <> 9
If Sheets(feuille).Cells(10, 11 + j).Locked = False Then
jour = j
Else
j = j + 1
End If
Wend
jour = jour - 1
Week = ActiveSheet.Range("H3").Value
Sheets("Arepartir").Visible = xlSheetVisible
Sheets("Arepartir").Cells.ClearContents
If Week < 10 Then
ToRecup = "DIV W" & "0" & Week
Else
ToRecup = "DIV W" & Week
End If
Application.Calculation = xlCalculationAutomatic
Sheets(ToRecup).Activate
i = 4
While Range("E" & i).Text = ""
i = i + 1
Wend
first = i
While Range("E" & i).Text <> ""
i = i + 1
Wend
'On récupère tout les produits à starter à partir de la feuille DIV de la semaine
produit = ""
Techno = ""
Range("E" & first & ":G" & i).Copy
Sheets("Arepartir").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
i = 2
Sheets("Arepartir").Range("A" & 1).FormulaR1C1 = "Produit"
Sheets("Arepartir").Range("B" & 1).FormulaR1C1 = "Qtt a start"
Sheets("Arepartir").Range("C" & 1).FormulaR1C1 = "Priorite"
Sheets("Arepartir").Range("D" & 1).FormulaR1C1 = "Qtt to define"
Sheets("Arepartir").Range("E" & 1).FormulaR1C1 = "PG"
Sheets("Arepartir").Range("F" & 1).FormulaR1C1 = "Groupe PG"
Sheets("Arepartir").Range("G" & 1).FormulaR1C1 = "WorkOrder"
Sheets("Arepartir").Range("H" & 1).FormulaR1C1 = "Division"
Sheets("Arepartir").Range("H" & 1).FormulaR1C1 = "Quota"
Sheets("Arepartir").Range("I" & 1).FormulaR1C1 = "Groupe Div"
Sheets("Arepartir").Range("J" & 1).FormulaR1C1 = "Point WO"
Sheets("Arepartir").Range("K" & 1).FormulaR1C1 = "Point Priorité"
Sheets("Arepartir").Range("L" & 1).FormulaR1C1 = "Point Techno"
Sheets("Arepartir").Range("M" & 1).FormulaR1C1 = "Point Quota"
Sheets("Arepartir").Range("N" & 1).FormulaR1C1 = "Point Quantité"
Sheets("Arepartir").Range("R" & 1).FormulaR1C1 = "Points Totaux"
'On ajoute la quantité à défirir la techno la division le groupe de techno et le groupe quota
While Sheets("Arepartir").Range("A" & i).Text <> ""
produit = Sheets("Arepartir").Range("A" & i).Text
DIV = ""
PG = ""
k = 10
While Sheets(feuille).Range("Y" & k).Text <> produit And Sheets(feuille).Range("Y" & k).Text <> ""
k = k + 1
Wend
Sheets("Arepartir").Range("D" & i).FormulaR1C1 = Sheets(feuille).Range("U" & k).Text
PG = Sheets(feuille).Range("C" & k).Text
Sheets("Arepartir").Range("E" & i).FormulaR1C1 = PG
Sheets("Arepartir").Range("G" & i).FormulaR1C1 = Sheets(feuille).Range("X" & k).Value
DIV = Sheets(feuille).Range("B" & k).Text
If DIV = "MMS" Then
j = 16
While Sheets("Informations_Repartition").Range("AD" & j).Text <> PG And Sheets("Informations_Repartition").Range("AD" & j).Text <> ""
j = j + 1
Wend
DIV = Sheets("Informations_Repartition").Range("AE" & j).Text
End If
Sheets("Arepartir").Range("H" & i).FormulaR1C1 = DIV
DIVQuota = 0
Select Case DIV
Case "APG": DIVQuota = 1
Case "SMD": DIVQuota = 2
Case "MCD": DIVQuota = 3
Case "MMY": DIVQuota = 4
End Select
If DIVQuota <> 0 Then Sheets("Arepartir").Range("I" & i).FormulaR1C1 = DIVQuota
l = 38
Groupe = False
While Params.Range("N" & l).Text <> "" And Groupe = False
If Params.Range("N" & l).Text = PG Then
Sheets("Arepartir").Range("F" & i).FormulaR1C1 = Params.Range("P" & l).Value
Groupe = True
Else
l = l + 1
End If
Wend
i = i + 1
Wend
'On fait un filtre pour toutes les quantités > 1
Columns("A:G").Select
ActiveSheet.Range("$A$1:$G$" & i).AutoFilter Field:=4, Criteria1:=">1", Operator:=xlFilterValues
Range("A1:Z" & i).SpecialCells(xlCellTypeVisible).Copy
Range("AA1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1:Z" & i).ClearContents
ActiveWorkbook.Worksheets("Arepartir").Sort.SortFields.Clear
Range("AA1:AZ" & i).Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("AA1:AZ" & i).ClearContents
i = 2
Letcapa = Chr(96 + 5 + 2 * jour)
Lettrestart = Chr(96 + 6 + 2 * jour)
If jour <> 7 Then
LetQuota = Chr(96 + 5 + 3 * jour)
LetReel = Chr(96 + 6 + 3 * jour)
Else
LetQuota = "Z"
LetReel = "AA"
End If
'On met les formules pour chaque produit qui calculent les points
While Sheets("Arepartir").Range("A" & i).Text <> ""
With Sheets("Arepartir")
If .Range("C" & i).Text = "" Then
.Range("K" & i).FormulaR1C1 = 0.15
Else
.Range("K" & i).FormulaR1C1Local = Pprio(.Range("C" & i).Value - 1)
End If
Sheets("Arepartir").Activate
.Range("J" & i).Formula = "=IF(G" & i & ">0," & PWO(0) & "," & PWO(1) & ")"
.Range("L" & i).Formula = "=IF(F" & i & "=0," & PTechno(1) & ",IF('Informations_Repartition'!" & Letcapa & 2 + .Range("F" & i).Value & ">'Informations_Repartition'!" & Lettrestart & 2 + .Range("F" & i).Value & "," & PTechno(0) & "," & PTechno(2) & "))"
.Range("M" & i).Formula = "=IF(OR(H" & i & "=""APG"" ,H" & i & "=""MCD"",H" & i & "=""SMD"",H" & i & "=""MMY""),IF(ROUNDUP('Informations_Repartition'!" & LetQuota & 16 + .Range("I" & i).Value & ",0)*0.8>'Informations_Repartition'!" & LetReel & 16 + .Range("I" & i).Value & "," & PQuota(0) & ",IF(ROUNDUP('Informations_Repartition'!" & LetQuota & 16 + .Range("I" & i).Value & ",0)*1.005>'Informations_Repartition'!" & LetReel & 16 + .Range("I" & i).Value & "," & PQuota(1) & "," & PQuota(2) & "))," & PQuota(0) & ")"
.Range("N" & i).Formula = "=IF(D" & i & " =0,0,(" & PQt(0) & "+" & .Range("D" & i).Value & "*" & PQt(1) & "))"
.Range("R" & i).Formula = "=PRODUCT(J" & i & ":N" & i & ")"
End With
i = i + 1
Wend |
Partager