Discussion :

[iliesss]

Bonjour
Voici ma feuil qui représente la situation d’un compte a la fin du mois.
Maintenant mon travail est de faire un rapprochement ou lettrage c.-à-d. identifier le montant (débit ou crédit) et trouver sont doublons (débit ou crédit) et supprimer les deux lignes ensembles
Voici un exemple de mon fichier

[unparia]

Bonjour
Conception à repenser totalement --->>
Je rappelle au comptable principal que deux montants identiques en recette et dépense ne permettent absolument pas de déterminer avec assurance qu'ils concernent la même transaction, pas plus que deux poids identiques n'identifient forcément la même personne !
Et ce que montre ton image (les "xxxxxx..." en particuler") ne permet pas de te conseiller au-delà.

[John Mc Evee]

Bonjour iliesss, et bonjour le forum,

Pourrais tu nous mettre un exemple avec un avoir partielle sur une facture afin de voir les jointures possibles ?

A+

[iliesss]

bonjour
Mr Unparia
oui tu as raison ne permettent absolument pas de déterminer avec assurance qu'ils concernent la même transaction
je vais essayer expliquer mieux

Mr John
dans notre service la facture passe par deux phases
1- constatation (le comptable peux choisir le TYPE exp: ACH,OD,AEI.....)
au débit un compte de charge et compte taxe
au crédit un compte de fournisseur

2- règlement (le comptable est obligée de mettre TYPE "BQD"
au débit le même compte fournisseur
an crédit un compte de banque

et mon travail de supprimer la ligne de crédit constatation et la ligne de débit règlement avec 3 critère N°pièce +code fournisseur+ le montant


ça c'est un model de facture


et voila le fichier qui explique tous la constatation et le règlement et le rapprochement

[John Mc Evee]

Bonsoir iliesss,

Je me suis mal exprimé. J'ai besoin de savoir comment tu rapproches une facture impactée par un avoir ? L'avoir comprend t-il dans son libellé le n° de facture et peut-on le différencier d'une écriture d'achat autre que sur un montant au débit au lieu de crédit (Type de journal, N° de pièce,...) ?

Ex :
Facture n°2241: 100€ - libellé : 3333-xxxx
Avoir n°2355: 20€ - libellé : 3333-2241
Règlement n°1465 : 80€ - libellé : 3333-2241

Sinon j'ai bien avancer sur une proposition il me reste que ce point de détail a voir . Elle est un peu plus complexe mais suffisamment générique pour l'adapter à d'autre contexte.

A+

[iliesss]

bonsoir Mr John
dans ma question je j'ai pas un avoir
j'ai uniquement une facture et sont payement(règlement).

exp

Facture n°2450 TYPE ACH Libelle 36474-xxxxxxxx débit 0 crédit 100

Règlement n°1258 TYPE BQD Libelle 36474-xxxxx 2450 débit 100 crédit 0

on suppose que cette fonction et dans la colonne I
si type<>BQD then 2450+36474+0+100 sinon (extraire 2450)+36474+100+0
dans la colonne J j'utilise la fonction NB.SI pour détecter les doublons
et a la fin je supprime la valeur avec sont doublons

[John Mc Evee]

Ok sa marche. Je finis ma proposition et je la poste.

[John Mc Evee]

Bonsoir iliesss,

Je viens de terminer ma proposition. Un petit casse-tête bien plus difficile à résoudre que la ventilation. Cependant je ne l'ai testé que sur un petit volume de donnée donc il faut voir dans un cas pratique si cela fonctionne.

En plus de répondre a ta problématique, j'ai extrapolé le processus pour d'autre compte de tiers (client) et incrémenter une gestion des avoirs.

Le processus prend en entrée deux paramètres (le nom de la feuille et la suppression ou non des lignes lettrées) et est dépendant de deux sous procédures (Encodage & LigneUnique)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
Option Explicit
'*******************************************************************************************************
' NAME : LettrageCompte (PROCESS)
' AUHTOR : John Mc Evee
' VERSION : 1.0
' DATE : 01/12/2018
'
' INPUT : sSheetName (String), bViewUniqueRow (Boolean)
' DESCRIPTION : Le processus va analyser toutes les lignes d'une balance ou d'un compte comptable afin
' d'identifier les rapprochements entre documents et règlements. Le processus est valide sur les
' balance de tous les comptes de tiers
'
' La clé unique de chaque ligne se compose comme suit :
' - Code Comptable & N° de pièce & Code Tiers
'
' Pour éviter des erreurs de rapprochement, il faut identifier la nature de la ligne (Facture, Avoir ou
' Règlement). Pour cela, on testera le sens (Debit/Crédit) avec le code journal.
' En conclusion, un rapprochement sera considérer comme valide si les clés sont identiques et que
' que les sens d'écriture s'équilibre entre eux.
' La clé ne contient pas le montant pour pouvoir rapprocher les avoirs (partiel). Test l'équilibre entre
' les clés grâce à la fontion SOMME.SI de la bibliothèque Excel
'
' DEPENDANCE : Encodage (FUNCTION) & LigneUnique (PROCESS)
'*******************************************************************************************************
 
'Renseigner les codes journaux pour la gestion des N° de pièce
Private Const sJournalBQ   As String = "BQD"
Private Const sJournalVT   As String = "VT"
Private Const sJournalACH  As String = "ACH"
Private Const sJournalOD   As String = "OD"
 
'Premier lettrage avec comme suivant "AAB" etc
'Limiter à 17576 rapprochements différents. Si besoin de plus ajouter comme suit "AAAA"
'Chaque lettre ajoute un facteur 26 de combinaison
Private Const sFirstLettrage As String = "AAA"
 
Public Sub LettrageCompte(sSheetName As String, Optional bViewUniqueRow As Boolean = False)
 
    Dim oSheetData        As Excel.Worksheet       'Feuille contenant les données
    Dim oRangeData        As Excel.Range           'Plage contenant les clés de lettrage
    Dim oRangeLettrage    As Excel.Range           'Cellule contenant la clé de lettrage
    Dim iRow              As Integer               'Compteur de ligne
    Dim iFirstRow         As Integer               'Ligne des entêtes
    Dim iLastRow          As Integer               'Dernière ligne du tableau
    Dim iFirstColumn      As Integer               'Première colonne
    Dim iLastColumn       As Integer               'Dernière colonne (ligne Entête)
    Dim iColumnLettrage   As Integer               'Dernière colonne + 1
 
    Dim sLettrage         As String                'Code du lettrage
    Dim sKey              As String                'Clé de lettrage
    Dim sNumPiece         As String                'Numéro de pièce comptable
    Dim sLibelle          As String                'Libelle de la ligne comptable
    Dim sCodeJournal      As String                'Code journal de la ligne comptable
    Dim sCodeTiers        As String                'Code du tiers
    Dim sCompteTiers      As String                'Compte comptable du tiers
    Dim cMontantDebit     As Currency              'Montant de la ligne comptable au débit
    Dim cMontantCredit    As Currency              'Montant de la ligne comptable au crédit
 
    Application.ScreenUpdating = False
 
    'Fixe de la feuille
    Set oSheetData = ThisWorkbook.Worksheets(sSheetName)
 
    With oSheetData
 
        'Calcul de la plage à analyser (A adapter au besoin)
        iFirstRow = 8
        iFirstColumn = 1
 
        iLastRow = .Cells(iFirstRow, iFirstColumn).End(xlDown).Row
        iLastColumn = .Cells(iFirstRow, .Columns.Count).End(xlToLeft).Column
 
        'Test de complétude
        If .Cells(iFirstRow, iLastColumn).Value = "LETTRAGE" Then
            .Columns(iLastColumn).Delete xlToLeft
            iLastColumn = iLastColumn - 1
        End If
 
        'Formatage de la nouvelle colonne
        iColumnLettrage = iLastColumn + 1
        .Cells(iFirstRow, iColumnLettrage).Value = "LETTRAGE"
        .Columns(iLastColumn).Copy
        .Columns(iColumnLettrage).PasteSpecial xlPasteFormats
        .Columns(iColumnLettrage).HorizontalAlignment = xlCenter
 
        '******************************************************************************************
        'Création des clés de lettrage
        '******************************************************************************************
        For iRow = iFirstRow + 1 To iLastRow Step 1
 
            sKey = VBA.vbNullString
 
            'Colonne a adapter à la structure du tableau
            'On récupère les valeurs nécessaire à la création de la clé de lettrage
            sCodeJournal = .Cells(iRow, 3).Value
            sCompteTiers = .Cells(iRow, 5).Value
            sLibelle = .Cells(iRow, 6).Value
 
            'Libelle = "33078-xxxxxxx 0002241 xx/xxxx xxx_/xxxxx/xxxxx"
            'CodeTiers = "33078"
            sCodeTiers = VBA.Left$(sLibelle, VBA.InStr(sLibelle, "-") - 1) 'A adapter au besoin
 
 
            'On récupère le numéro de pièce en fonction du code journal et du sens de l'écriture
            Select Case sCodeJournal
 
            Case sJournalBQ   'Journal de banque
 
                'Libelle = "33078-xxxxxxx 0002241 xx/xxxx xxx_/xxxxx/xxxxx"
                'NumPiece = "0002241 xx/xxxx xxx_/xxxxx/xxxxx"
                sNumPiece = VBA.Mid$(sLibelle, VBA.InStr(sLibelle, " ") + 1, VBA.Len(sLibelle))
                'NumPiece = "0002241"
                sNumPiece = VBA.Left$(sNumPiece, VBA.InStr(sNumPiece, " ") - 1) 'A adapter au besoin
 
            Case sJournalVT   'Journal de vente
 
                'Si le document est une facture (montant au débit)
                If .Cells(iRow, 7) <> 0 Then
                    sNumPiece = .Cells(iRow, 4).Value
                Else 'Si un avoir
                    'A adapter pour récupérer le n° de facture concerné
                    sNumPiece = VBA.Mid$(sLibelle, VBA.InStr(sLibelle, " ") + 1, VBA.Len(sLibelle))
                    sNumPiece = VBA.Left$(sNumPiece, VBA.InStr(sNumPiece, " ") - 1)
                End If
 
            Case sJournalACH 'Journal d'achat
 
                'Si le document est une facture (montant au crédit)
                If .Cells(iRow, 8) <> 0 Then
                    sNumPiece = .Cells(iRow, 4).Value
                Else 'Si un avoir
                    'A adapter pour récupérer le n° de facture concerné
                    sNumPiece = VBA.Mid$(sLibelle, VBA.InStr(sLibelle, " ") + 1, VBA.Len(sLibelle))
                    sNumPiece = VBA.Left$(sNumPiece, VBA.InStr(sNumPiece, " ") - 1)
                End If
 
            Case sJournalOD 'Journaux des opérations diverses
 
                sNumPiece = .Cells(iRow, 4).Value
 
            End Select
 
            'Clé = Code Comptable & N° de pièce & Code Tiers
            sKey = sCompteTiers & "-" & sNumPiece & "-" & sCodeTiers
            .Cells(iRow, iColumnLettrage).Value = sKey
 
        Next iRow
 
        '******************************************************************************************
        'Encodage au format lettrage ("AAA")
        '******************************************************************************************
        Set oRangeData = .Range(.Cells(iFirstRow, iColumnLettrage), _
                                .Cells(iLastRow, iColumnLettrage))
 
        For iRow = iFirstRow + 1 To iLastRow Step 1
 
            'Clé = Code Comptable & N° de pièce & Code Tiers
            sKey = .Cells(iRow, iColumnLettrage).Value
 
            'Si la clé n'a pas été rapproché
            If VBA.InStr(sKey, "-") <> 0 Then
 
                'Calcul des montants grâce à la fonction Excel SOMME.SI (Offset à adapter au besoin)
                cMontantDebit = CCur(WorksheetFunction.SumIf(oRangeData, _
                                     sKey, oRangeData.Offset(0, -2)))
 
                cMontantCredit = CCur(WorksheetFunction.SumIf(oRangeData, _
                                      sKey, oRangeData.Offset(0, -1)))
 
                'Si les montants sont égaux
                If cMontantDebit = cMontantCredit Then
 
                    'alors on génère une nouvelle clé de lettrage
                    If sLettrage = VBA.vbNullString Then
                        sLettrage = sFirstLettrage
                    Else
                        sLettrage = Encodage(sLettrage)
                    End If
 
                    'On recherche les lignes à lettrer (min 2)
                    Set oRangeLettrage = oRangeData.Find(sKey)
 
                    Do
                        'Affectation du lettrage
                        .Cells(oRangeLettrage.Row, iColumnLettrage).Value = sLettrage
 
                        'Recherche de la ligne suivante à lettrer
                        Set oRangeLettrage = oRangeData.FindNext(oRangeLettrage)
 
                    Loop While Not oRangeLettrage Is Nothing
 
                Else
                    'Si pas de correspondance on supprime
                    .Cells(iRow, iColumnLettrage).ClearContents
 
                End If
 
           End If
 
        Next iRow
 
        'Si l'option est sur vrai
        If bViewUniqueRow Then
            Call LigneUnique(.Name, iColumnLettrage)
        End If
 
    End With
 
    Application.ScreenUpdating = True
 
End Sub
 
'**************************************************************************************************
' NAME : LigneUnique (PROCESS)
' INPUT : sSheetName (String), iColumnLettrage (Integer)
' DESCRIPTION : Le processus va analyser toutes les lignes d'un compte comptable et en fonction
' du lettrage préalablement effectué, il va supprimer toutes les lignes rapprochées.
'**************************************************************************************************
Public Sub LigneUnique(sSheetName As String, iColumnLettrage As Integer)
 
    Dim oSheetData   As Excel.Worksheet       'Feuille contenant les données
    Dim oRangeData   As Excel.Range           'Plage contenant les données à supprimer
    Dim iFirstRow    As Integer               'Ligne des entêtes
    Dim iLastRow     As Integer               'Dernière ligne du tableau
    Dim iFirstColumn As Integer               'Première colonne
    Dim iLastColumn  As Integer               'Dernière colonne (ligne Entête)
    Dim iRow         As Integer               'Compteur de ligne
 
 
    'Fixe de la feuille
    Set oSheetData = ThisWorkbook.Worksheets(sSheetName)
 
    With oSheetData
 
        'Calcul de la plage à analyser
        iFirstRow = 8 'A adapter au besoin
        iFirstColumn = 1
 
        iLastRow = .Cells(.Rows.Count, iColumnLettrage).End(xlUp).Row
        iLastColumn = .Cells(iFirstRow, .Columns.Count).End(xlToLeft).Column
 
        'Test de complétude
        If iLastColumn < iColumnLettrage Then Exit Sub
 
        'Pour toutes les lignes du tableau en partant de la fin
        For iRow = iLastRow To iFirstRow + 1 Step -1
 
            'Si la ligne a été lettré alors on supprime
            If .Cells(iRow, iColumnLettrage).Value <> VBA.vbNullString Then
 
                .Rows(iRow).Delete xlUp
 
            End If
 
        Next iRow
 
    End With
 
End Sub
 
'**************************************************************************************************
' NAME : Encodage (FUNCTION)
' INPUT : sPreviousText (String)
' OUPUT : sText (String)
' DESCRIPTION : La fonction va attribuer un code unique en incrémentant à partir d'un texte
' précédent. A titre d'exemple : AAA --> AAB --> AAC
'**************************************************************************************************
Private Function Encodage(sPreviousText As String) As String
 
    Dim iBuffer As Integer  'Position du premier Z
    Dim sText   As String   'Texte retourné par la fonction
    Dim sLetter As String   'Lettre du buffer
 
    'On affecte l'ancien text au format Majuscule
    sText = VBA.UCase$(sPreviousText)
    'On initialise le compteur
    iBuffer = VBA.Len(sText)
 
    'On test si la chaine contient la lettre Z Chr(90)
    Do While VBA.Mid$(sText, iBuffer, 1) = VBA.ChrW$(90)
 
        iBuffer = iBuffer - 1
        If iBuffer = 0 Then Exit Do
 
    Loop
 
    'Si tous le texte contient des Z alors
    If iBuffer = 0 Then
 
        sText = "Limite atteinte"
 
    'Si la dernière lettre est différente de Z
    ElseIf iBuffer = VBA.Len(sText) Then
 
        'sLetter = "A"
        sLetter = VBA.Mid$(sText, iBuffer, 1)
 
        'sText = AAA --> AAB or SRQ --> SRR
        sText = VBA.Left$(sText, iBuffer - 1) & _
                VBA.Replace(VBA.Mid$(sText, iBuffer, 1), sLetter, _
                VBA.ChrW$(VBA.AscW(sLetter) + 1))
 
    'Sinon on incrémente la lettre du buffer de 1 et on remplace les Z par A
    Else
 
        'SLetter = "Z"
        sLetter = VBA.Mid$(sText, iBuffer, 1)
        'sText = AZZ --> BAA or AAZZZZ --> ABAAAA
        sText = VBA.Left$(sText, iBuffer - 1) & _
                VBA.Replace(VBA.Mid$(sText, iBuffer, 1), sLetter, _
                VBA.ChrW$(VBA.AscW(sLetter) + 1)) & _
                VBA.Replace(VBA.Right$(sText, VBA.Len(sText) - iBuffer), _
                VBA.ChrW$(90), VBA.ChrW$(65)) 'Chr(65) = "A"
 
    End If
 
    'On renvoi le texte incrémenté de 1
    Encodage = sText
 
End Function
 
'**************************************************************************************************
' Lancement de la macro
' A placer seul ou dans une autre procédure
'**************************************************************************************************
Public Sub Lancement()
 
    Dim sSheetName As String    'Nom de la feuille à lettrer
    Dim bSupprRow  As Boolean   'Supprimer les lignes lettrées
 
    sSheetName = "40120"
    bSupprRow = True
 
    Call LettrageCompte(sSheetName, bSupprRow)
 
End Sub

Pour l'implémentation dans ton fichier précédent, il faut rajouter ces lignes ici (module Ventiler)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
  '5 - Suppression des colonnes
                .Columns("I:J").Delete
 
            End If
 
        End With
 
        '--------------------------------------------------------------------- A ajouter Ici
        'True pour supprimer les lignes et False pour les conserver
        'Pour vérifier la bonne construction du code utiliser false
        'au début. Si le processus contrôle bien toutes les configurations
        'alors passe à vrai
        bSupprRow = True
 
        Call LettrageCompte(.Name, bSupprRow)
 
    Next oSheetData

Et voici le résultat de sortie : Tu remarqueras que le processus utilise un lettrage sous format "AAA" qui est limité à 26^3 rapprochements mais tu peux modifier la constante pour augmenter le nombre au besoin




Avec le fichier joint : RaprochementV2.xlsm

PS : A tous les comptables qui passerais par là et qui se casse la tête sur ce problème simple mais parfois long à traiter :

Pour adapter le concept, il suffit de :
- modifier les codes journaux
- ajuster les numéros de colonnes et la première ligne à votre fichier
- modifier la manière dont on récupère le n° de pièce dans les libellés (en fonction des natures des documents comptables)
- supprimer le numéro du tiers (différent du compte comptable) si vous n'en possédez pas.

A+

[iliesss]

Bonjour
John Mc Evee
parfait et 10/10 tous fonctionne très très bien tu m'as beaucoup aider et j'ai appris beaucoup de chose grâce a vous.

Svp comment je remplace le nom de feuil sSheetName = "40120" par la feuil active sSheetName = Activesheet

[John Mc Evee]

Bonsoir,

En appelant la propriété name de l'objet ActiveSheet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.Name

Un plaisir, je penses continuer à l'améliorer car il manque encore un lettrage pour un paiement correspondant à plusieurs factures.

A+

[iliesss]

Merci beaucoup
maintenant j'ai regrouper tous votre code la ventilation et le lettrage et la fin j'ai un fichier propre et fiable et le plus important c'est le temps gager.
Mille merci Mr John je vous souhaite une vie pleine de joie pleine de sante plein de prospérité.
je vais demander au notre comptable de ma société d'uniformiser les libelle pour un bon rapprochement
et maintenant je vais essayé de faire une formule pour supprimer les pièce contre-passer pour réduire les lignes dans mon fichier