LETTRAGE AVEC VBA

Version imprimable

1 pièce(s) jointe(s)

LETTRAGE AVEC VBA

Bonjour,

Je travaille avec VBA qui me permet de lettrer des écritures débit - crédit et d'identifier celles qui se lettrent et de leurs accorder un code lettrage.

Cependant, il existe des lignes qui leurs soldes est égale à 0 et le VBA les considèrent comme différents et leurs attribuent 0 en colonne lettrage. (ci-joint un aperçu de fichier)

Pièce jointe 584799

Etant débutante en VBA, j'aimerais bien savoir où est l'erreur sur le code :

Code:

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
Option Explicit
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
With ActiveSheet
    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) = dic(mof) + tMt(lig, 1)
        Else
            dic.Add mof, tMt(lig, 1)
        End If
    Next lig
    tdk = dic.keys: ReDim t_l(1 To 3)
    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)
        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
Public Function d_lettre(tbl)
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

Merci pour votre aide.

Citation:

Envoyé par FanSu

Bonjour,

Etes-vous certaine que les montants ont tous deux chiffres après la virgule ? Vous aurez remarqué que le seul cas qui fonctionne, c'est lorsque vous avez des valeurs entières.

Regardez si en arrondissant à deux chiffres après la virgule dans votre code, cela règle le problème :
Code:

1 2 3 4 5 6 7 8 9 10 11 For lig = 1 To UBound(tOP) mof = tOP(lig, 1) & "|" If dic.Exists(mof) Then dic(mof) = dic(mof) + Round(tMt(lig, 1), 2) Else dic.Add mof, Round(tMt(lig, 1), 2) End If Next lig
Nb : Lorsque vous éditez du code dans vos messages, sélectionnez-le et cliquez sur la balise # dans le menu, et indentez vos lignes.

24/11/2020, 21h07
FanSu

Bonjour Eric,

Merci tout d'abord pour votre feed-back, A propos de ta remarque, oui exactement le lettrage est attribuer juste aux montants entier.

Et j'ai essayé avec la modification du code que tu m'as envoyé et ça marche toujours pas.

Je met en attaché le fichier excel pour plus de clarté.

Salutations.

Citation:

Envoyé par FanSu

Lorsqu'un code ne fonctionne pas comme il faut, il ne faut pas hésiter à placer des Debug.print pour voir ce que vous récupérez à chaque passage dans les boucles. Ici, j'ai pris comme exemple l'opération OP0278/20 et j'ai modifié le code comme ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
            For Lig = 1 To UBound(tOP)
 
                mof = tOP(Lig, 1) & "|"
                If Dic.Exists(mof) Then
                    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

Le résultat dans la fenêtre exécution (Ctrl-G) a donné cela :
Pièce jointe 584935

Il faut donc arrondir sur la somme. Le code est donc à modifier comme ceci :

Code:

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

Nb : En démarrant les boucles à 1 dans les matrices tdk et tOP, la première pièce "OP3074/19" n'est pas prise en compte car les indices doivent démarrer à 0. Le plus simple est de noter LBound

08/12/2020, 20h49
FanSu

Merci énormément Eric