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
| Option Explicit
'-----------------------------------------------------------------------
Public Sub lettrer()
'------------------ paramètres à adapter -------------------------------
Const ldb = 6 ' ligne début tableau
Const cOP = "E" ' colonne OP
Const cFR = "F" ' colonne FR
Const cMt = "D" ' colonne montant
Const crs = "J" ' colonne lettrage
'-----------------------------------------------------------------------
Dim lig As Long ' ligne traitée
Dim dic ' dictionnaire données
Dim mof As String ' mixte OP / FR
Dim tOP, tFR, tMt ' tables données
Dim tdk ' table clés écritures
With ActiveSheet ' feuille >- tables
lig = .Cells(.Rows.Count, cOP).End(xlUp).Row + 1
tOP = .Cells(ldb, cOP).Resize(lig - ldb, 1).Value
tFR = .Cells(ldb, cFR).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) ' agglomérations valeurs
mof = tOP(lig, 1) & "|" & tFR(lig, 1)
If dic.Exists(mof) Then
dic(mof) = dic(mof) + tMt(lig, 1)
Else
dic.Add mof, tMt(lig, 1)
End If
Next lig
tdk = dic.keys: ReDim t_l(1 To 4) ' lettrage
For lig = 1 To UBound(tdk)
If dic(tdk(lig)) = 0 Then dic(tdk(lig)) = d_lettre(t_l)
Next lig
For lig = 1 To UBound(tOP) ' affectation lettrage
mof = tOP(lig, 1) & "|" & tFR(lig, 1): trs(lig) = dic(mof)
Next lig
.Cells(ldb, crs).Resize(UBound(trs), 1).Value = Application.Transpose(trs)
End With
End Sub
'-----------------------------------------------------------------------
Public Function d_lettre(tbl) ' génération du lettrage
Dim idx As Integer, plu As Integer
For idx = 1 To UBound(tbl): d_lettre = d_lettre & Chr(tbl(idx) + 65): Next
plu = 1
For idx = UBound(tbl) To 1 Step -1
If tbl(idx) < 25 Then: tbl(idx) = tbl(idx) + plu: Exit For: Else: tbl(idx) = 0
Next
End Function
'----------------------------------------------------------------------- |
Partager