Discussion :

[iliesss]

Bonjour
Je suis un comptable et j’ai un problème dans les pièces contre passer.
si le comptable commis une erreur il n’as pas le droit de supprimer cette pièce il a une seule solution c’est de contre passer cette pièce.

Le principe de contre passer
Crée une autre pièce et garder les mêmes informations de la pièce original avec l'inversassions des montants debit credit et ajouter "-C_" & N°piece Initiale dans le libelle.
Voici un Exemple


La piece N°0000998 est la piece qui contient des erreur
La piece N°0001363 est la piece qui annule La piece N°0000998
dans cette piece contre passer
1-les montant debit credit sont inverses
2-dans le libelle un "-C_" + le numéro de la piece initiale

A la fin d'année je trouve un problème de rapprochement donc je souhaite supprimer les pieces et ses contres passer

je partage avec vous ma modeste solution

1-copier toute la plage et coller pour supprimer les double dans la colonne N°piece
2-creation une clé pour identifier la piece et sa contre passer (lien entre les deux pieces)
3-cree une liste de piece initial et contre passer
4-un filtre avance avec zone de critère la liste de piece initial et contre passer
5-supprimer les ligne visible

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
Sub ILIES()
Dim ShGr As Worksheet
Dim Arr, Brr, x
Dim plage1 As Range, plage2 As Range, plage3 As Range, plage4 As Range, plage5 As Range
Set ShGr = ThisWorkbook.Worksheets("GrandLivre")
LignB = ShGr.Cells(ShGr.Rows.Count, 1).End(xlUp).Row
Set plage1 = ShGr.Range("H2:H" & LignB)
Set plage2 = ShGr.Range("D2:D" & LignB)
 
'====================================================================================
ShGr.Range("A2:F" & LignB).Copy
ShGr.Range("L2:Q" & LignB).PasteSpecial
ShGr.Range("L2:Q" & LignB).RemoveDuplicates Columns:=4, Header:=xlYes
'=====================================================================================
LignC = ShGr.Cells(ShGr.Rows.Count, 12).End(xlUp).Row
Brr = ShGr.Range("L3:R" & LignC)
 
   For i = LBound(Brr) To UBound(Brr)
 
        If Brr(i, 6) Like "*-C_*" Then
            x = Split(Brr(i, 6), "_")
            Brr(i, 7) = x(1) & "_" & Replace(x(0), "-C", "") & "_" & Application.WorksheetFunction.SumIf(plage2, x(1), plage1)
 
        Else
 
            Brr(i, 7) = Format(Brr(i, 4), "0000000") & "_" & Split(Brr(i, 6), "-")(0) & "_" & Application.WorksheetFunction.SumIf(plage2, Brr(i, 4), plage1)
 
        End If
   Next i
   ShGr.Range("L3:R" & LignC) = Brr
'=======================================================================================
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In ShGr.Range("R3", [R65000].End(xlUp))
    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
Next c
'========================================================================================
ShGr.Columns("J:J").NumberFormat = "General"
ShGr.Range("J2").Value = "N°PIECE"
i = 3
For Each c In ShGr.Range("R3", [R65000].End(xlUp))
    If mondico.Item(c.Value) > 1 Then
    'c.Interior.ColorIndex = 4
    ShGr.Range("J" & i) = c.Offset(0, -3)
    i = i + 1
    End If
Next c
'==========================================================================================
If ShGr.Range("J2").Value <> "" Then
ShGr.Range("A2:H" & LignB).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ShGr.Range("J2").CurrentRegion, Unique:=False
ShGr.Range("_FilterDataBase").Offset(1, 0).Resize(Range("_FilterDataBase").Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
ShGr.ShowAllData
End If
ShGr.Columns("I:U").ClearContents
End Sub

le ficher réel contient 150000 lignes
et voici un petit exemple

[jawed]

Bonjour iliesss
Merci tres bien et mois qui passe par ces six etapes

1- Remplacer tous le "C_*_" par ""
2- Ajouter une colonne Solde ou tu calcul "Débit-Crédit"
3- Avec un TCD tu insère dans la ligne le champ "LIBELLE" et dans calcul le champ "Solde"
4- Tu copie et colle en valeur dans une autre feuille tous les champs dont leur libellé est égal a zéro
5- Tu procède par une RECHERCHEV sur ton grand livre tous les champs dont leur libelle sont équivalent a ceux figurant dans la nouvelle feuille
6- Tu supprime tous les lignes du grand livre dont leur solde est égal a zéro

A TESTER POUR VOIR

Cordialement
A bientôt