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
| Sub recordata(itemNum, ItemDes, ItemQty, Itemdate, ItemCTA, itemProj, ItemDA, nlenre)
Dim ShPW As Object
Set ShPW = Sheets("Prev")
With ShPW
If .Cells(nlenre, 1).Value = "" Then .Cells(nlenre, 1).Value = ItemCTA
If .Cells(nlenre, 2).Value = "" Then .Cells(nlenre, 2).Value = itemNum
If .Cells(nlenre, 3).Value = "" Then .Cells(nlenre, 3).Value = ItemDes
.Cells(nlenre, 4).NumberFormat = "@"
If .Cells(nlenre, 4).Value = "" Then
.Cells(nlenre, 4).Value = itemProj
Else
'valrech = InStr(.Cells(nlenre, 4).Text, itemProj, 1) 'le problème est ici c'est normal tu demande le 1( premiere occurence alors que tu sais pas si la condition est rempli a savoir si il y est ou pas
valrech = InStr(.Cells(nlenre, 4).Text, itemProj) 'le problème n'est plus ici on ne cherche pas l'occurence on comptabilise c'est tout
If Not (valrech >= 1) Then
.Cells(nlenre, 4).Value = ShPW.Cells(nlenre, 4).Value & vbLf & itemProj
End If
End If
If .Cells(nlenre, 5).Value = "" Then
.Cells(nlenre, 5).Value = ItemDA
Else
valrech = InStr(.Cells(nlenre, 5).Value, ItemDA, 1)
If Not (valrech >= 1) Then
.Cells(nlenre, 5).Value = .Cells(nlenre, 5).Value & vbLf & ItemDA
End If
End If
If WorksheetFunction.EoMonth(Itemdate, 0) < WorksheetFunction.EoMonth(Date, -2) + 1 Then
recdate = .Cells(1, initcell).Value
Else
recdate = Format(Itemdate, "mm/yy")
End If
'recherche le mois d'affectation des Qtés
ncol = Application.WorksheetFunction.Match(recdate, Rows(1), 0)
.Cells(nlenre, ncol).Value = ItemQty + .Cells(nlenre, ncol).Value
'mise en couleur de la case
If ItemDA <> "" Then
Call colorDA(nlenre, ncol) 'vert si DA
Else
Call colorprev(nlenre, ncol) 'bleu si planned order
End If
End With
End Sub |
Partager