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
| Sub Comput_Stock()
Dim FactRng As Range, PFRng As Range, StkRng As Range
Dim RowN As Integer, ColN As Integer, CmdQty As Integer, StockQty As Integer, RowPF As Integer
Dim WarnMsg As String, InfoMsg As String, Carticle As Integer 'a vérifier
Dim RoutinNam As String
'Init
RoutinNam = "Comput_Stock"
Set FactRng = Worksheets("Facturation1").Range("C16").CurrentRegion
Set PFRng = Worksheets("Produits fini").Range("B8").CurrentRegion
' On sort si une des deux range est non remplie
If FactRng.Rows.Count <= 1 Or PFRng.Rows.Count <= 1 Then
MsgBox "Rien à processer", vbExclamation
Exit Sub
End If
' On enlève la 1ere ligne des deux ranges
Set FactRng = FactRng.Offset(1, 0).Resize(FactRng.Rows.Count - 1)
Set PFRng = PFRng.Offset(1, 0).Resize(PFRng.Rows.Count - 1)
Debug.Print FactRng.Address, PFRng.Address
' On parcourt la 1ere colonne de FactRng pour le traitement
For RowN = 1 To FactRng.Rows.Count
'Si la cellule est non vide
If Not (IsEmpty(FactRng(RowN, 1))) Then
'On récupère les informations article, Qty commande et Stock
Carticle = FactRng(RowN, 1)
CmdQty = FactRng(RowN, 5)
StockQty = Application.WorksheetFunction.VLookup(Carticle, PFRng, 3, 0)
If CmdQty > StockQty Then
WarnMsg = WarnMsg & "Article " & Carticle & ": Qté insuffisante en stock " & StockQty & " / cde de: " & CmdQty & vbCrLf
Else:
InfoMsg = InfoMsg & "OK Article " & Carticle & ": Qté suffisante en stock " & StockQty & " / cde de: " & CmdQty & vbCrLf
' On récupère la ligne du stock et on met à jour la qté
RowPF = Cells(Application.WorksheetFunction.Match(Carticle, PFRng.Columns(1), 0)).Column
PFRng(RowPF, 3) = StockQty - CmdQty
Debug.Print PFRng(RowPF, 3).Address, Carticle, RowPF
End If
End If
Next RowN
If WarnMsg <> "" Then MsgBox WarnMsg, vbCritical, RoutinNam
If InfoMsg <> "" Then MsgBox InfoMsg, vbInformation, RoutinNam
End Sub |
