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
|
Public Sub lettrer()
Const ldb = 6
Const cOP = "D"
Const cMt = "F"
Const crs = "G"
Dim Lig As Long
Dim Dic
Dim mof As String
Dim tOP, tMt
Dim tdk
Dim ShEtat As Worksheet
Set ShEtat = Sheets("ETAT 4438")
With ShEtat
Lig = .Cells(.Rows.Count, cOP).End(xlUp).Row + 1
tOP = .Cells(ldb, cOP).Resize(Lig - ldb, 1).Value
tMt = .Cells(ldb, cMt).Resize(Lig - ldb, 1).Value
ReDim trs(1 To UBound(tOP))
Set Dic = CreateObject("Scripting.Dictionary")
Dic.RemoveAll
For Lig = 1 To UBound(tOP)
mof = tOP(Lig, 1) & "|"
If Dic.Exists(mof) Then
Dic(mof) = Round(Dic(mof) + tMt(Lig, 1), 2)
' Dic(mof) = Dic(mof) + Round(tMt(Lig, 1), 2)
Else
Dic.Add mof, Round(tMt(Lig, 1), 2)
End If
' If mof = "OP0278/20" & "|" Then
' Debug.Print "Ligne : " & Lig & ", montant " & tMt(Lig, 1) & ", valeur restante " & Dic(mof)
' End If
Next Lig
tdk = Dic.keys: ReDim t_l(1 To 3)
For Lig = LBound(tdk) To UBound(tdk) ' L'indice de la matrice démarre à 0
' For Lig = 1 To UBound(tdk)
If Dic(tdk(Lig)) = 0 Then Dic(tdk(Lig)) = d_lettre(t_l)
Next Lig
For Lig = LBound(tOP) To UBound(tOP) ' L'indice de la matrice démarre à 0
' For Lig = 1 To UBound(tOP)
mof = tOP(Lig, 1) & "|": trs(Lig) = Dic(mof)
Next Lig
.Cells(ldb, crs).Resize(UBound(trs), 1).Value = Application.Transpose(trs)
End With
End Sub |
Partager