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
| Option Explicit
Dim fm As Worksheet, tablo, tabloR1(), tabloR2(), tabloR3()
Dim dico1 As Object, dico2 As Object, dico3 As Object, dico4 As Object, dico5 As Object, dico6 As Object
Dim i&, j&, k1&, k2&, k3&, dte As Date, client$
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$A$6" Or Target.Address = "$D$6" _
And (Range("A6") <> "" And Range("D6") <> "") Then
Set dico1 = CreateObject("Scripting.Dictionary")
Set dico2 = CreateObject("Scripting.Dictionary")
Set dico3 = CreateObject("Scripting.Dictionary")
Set dico4 = CreateObject("Scripting.Dictionary")
Set dico5 = CreateObject("Scripting.Dictionary")
Set dico6 = CreateObject("Scripting.Dictionary")
Set fm = Sheets("Mouvement")
tablo = fm.Range(fm.Cells(3, 2), fm.Cells(fm.Range("B" & Rows.Count).End(xlUp).Row, 15))
k1 = 0: k2 = 0: k3 = 0: dte = Range("A6"): client = Range("D6")
For i = 1 To UBound(tablo, 1)
If tablo(i, 1) = "Sortie" And tablo(i, 2) = dte And tablo(i, 3) = Range("D6") Then
If tablo(i, 14) = "Agro" Then
If Not dico1.exists(tablo(i, 5)) Then
dico1(tablo(i, 5)) = tablo(i, 6) 'quantité
dico2(tablo(i, 5)) = tablo(i, 7)
Else
dico1(tablo(i, 5)) = dico1(tablo(i, 5)) + tablo(i, 6) 'quantité
End If
ElseIf tablo(i, 14) = "Legumes" Then
If Not dico3.exists(tablo(i, 5)) Then
dico3(tablo(i, 5)) = tablo(i, 6) 'quantité
dico4(tablo(i, 5)) = tablo(i, 7)
Else
dico3(tablo(i, 5)) = dico3(tablo(i, 5)) + tablo(i, 6) 'quantité
End If
ElseIf tablo(i, 14) = "Fruit" Then
If Not dico5.exists(tablo(i, 5)) Then
dico5(tablo(i, 5)) = tablo(i, 6) 'quantité
dico6(tablo(i, 5)) = tablo(i, 7)
Else
dico5(tablo(i, 5)) = dico5(tablo(i, 5)) + tablo(i, 6) 'quantité
End If
End If
End If
Next i
End If
Range("A17:C44,G17:I28,L17:N28").ClearContents
If Range("A6") = "" Or Range("D6") = "" Then GoTo fin
On Error GoTo fin
Range("A17").Resize(dico1.Count, 1) = Application.Transpose(dico1.keys)
Range("B17").Resize(dico1.Count, 1) = Application.Transpose(dico1.items)
Range("C17").Resize(dico1.Count, 1) = Application.Transpose(dico2.items)
Range("G17").Resize(dico3.Count, 1) = Application.Transpose(dico3.keys)
Range("H17").Resize(dico3.Count, 1) = Application.Transpose(dico3.items)
Range("I17").Resize(dico3.Count, 1) = Application.Transpose(dico4.items)
Range("L17").Resize(dico5.Count, 1) = Application.Transpose(dico5.keys)
Range("M17").Resize(dico5.Count, 1) = Application.Transpose(dico5.items)
Range("N17").Resize(dico5.Count, 1) = Application.Transpose(dico6.items)
fin:
Application.EnableEvents = True
End Sub
Sub Evenement()
Application.EnableEvents = True
End Sub |
Partager