XL 2013 Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Targui · 17 Février 2016

bonjour

ma question est la suivante :

je dispose d'un journal comptable établi sous Excel 2000

ce journal renferme plusieurs milliers d'enregistrement comptables.

je voudrais connaître, s'il existe une commande ou instruction spécifique me permettant d'eliminer tous les enregistrements ayant un solde nul (ie. débit positif , crédit négatif pour un même montant)

ex: enregistrement (ligne 1) .... .... ..... +1 000,00
enregistrement (ligne 2) .... .... ..... - 1 000,00
enregistrement (ligne 3) .... .... ..... +5 000,00
enregistrement (ligne 4) .... .... ..... +8 500,00

résultat recherché : .... .... .... +5 000,00
.... .... .... +8 500,00

NB : les enregistrements dont les montants s'annulent ne doivent pas apparaitre sur le journal.

job75 · 17 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonjour Targui,

La solution est une macro VBA qui supprimera ou masquera les lignes dont les montants s'annulent.

Il faut probablement une condition supplémentaire : le même "libellé" par exemple.

Tout cela est facile à programmer si vous nous fournissez un fichier allégé mais représentatif du problème.

Et bien sûr sans données confidentielles.

A+

klin89 · 17 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonsoir job75, Targui, le forum

Problème similaire dans ce fil, vois les différentes réponses.
https://www.excel-downloads.com/threads/macro-lettrage.20003899/

klin89

job75 · 17 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Re, bonsoir klin89,

Bon voyez ce fichier et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Code:

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Activate()
Dim col%, nlig&, ncol%, t, s$, i&, x$, j&, n&
col = 2 'n° de colonne des montants, à adapter
With Feuil1.[A1].CurrentRegion 'à adapter
  nlig = .Rows.Count
  ncol = .Columns.Count + 1 ' avec colonne auxiliaire
  t = .Resize(, ncol) 'matrice, plus rapide
End With
'---repérage des paires opposées---
s = Chr(1) 'séparateur
For i = 2 To nlig
  If IsNumeric(t(i, col)) And t(i, ncol) = "" Then
    x = t(i, 1) & s & -t(i, col)
    For j = i + 1 To nlig
      If x = t(j, 1) & s & t(j, col) Then
        t(i, ncol) = 1 'repérage
        t(j, ncol) = 1 'repérage
        Exit For
      End If
    Next j
  End If
Next i
'---élimination des lignes repérées---
For i = 1 To nlig
  If t(i, ncol) = "" Then
    n = n + 1
    For j = 1 To ncol - 1
      t(n, j) = t(i, j)
    Next j
  End If
Next i
'---restitution---
[A1].Resize(n, ncol - 1) = t
[A1].Offset(n).Resize(Rows.Count - n, ncol - 1).ClearContents
End Sub

J'utilise des tableaux VBA, c'est indispensable s'il y a un grand nombre de lignes.

Edit : j'ai copié A2:C5 sur A2:C4001.

Chez moi (Win 8 - Excel 2013) la macro s'exécute en 4,8 secondes.

L'imbrication de 2 boucles pour le repérage prend du temps.

Il y a peut-être des solutions plus rapides.

A+

job75 · 18 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Message annulé.

Targui · 18 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonjour,

Merci pour vos différentes réponses. En fait moi c'est une formule Excel qui m'arrangerait de type "=SI(ET(SOMMEPROD(($S$2:$S$9204=S17)*($F$2:$F$9204=-F17))>0;SOMMEPROD(($S$2:$S$9204=S17)*($F$2:$F$9204=-F9219))-SOMMEPROD(($S$2:$S$9204=S17)*($F$2:$F$9204=F17))<=0);"A LETTRER";"")" qui est dans le forum (klin89). Le souci c'est que je n'arrive pas à l'adapter pour que ça marche.

Vous trouveriez ci-dessous un modèle de grand livre que j'utilise des milliers de lignes (transactions). Vous comprendriez que ce sont généralement les écritures annulées que je voudrais extraire à part afin de pouvoir obtenir une liste sans les écritures annulées.

klin89 · 18 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Re Targui,

Il y a des incohérences , je ne parviens pas à obtenir le résultat souhaité.
Sur quelle(s) colonne(s) doit on s'appuyer pour déterminer les doublons ?
Quelle colonne de montants doit on prendre en compte ?

Dans l'exemple ci-dessous, c'est la variable txt qui définit les colonnes à prendre en compte (doublons).
A tester :

VB:

Option Explicit
Sub test()
Dim a, i As Long, txt As String, x As Range, e
    With Sheets("Feuil1").Cells(1).CurrentRegion
        .EntireRow.Interior.ColorIndex = xlNone
        a = .Value
        With CreateObject("Scripting.Dictionary")
            For i = 2 To UBound(a, 1)
                'colonne D
                If a(i, 4) > 0 Then
                    'txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))'colonnes A et B
                    txt = a(i, 1)    'colonne A
                    If Not .exists(txt) Then
                        Set .Item(txt) = CreateObject("Scripting.Dictionary")
                    End If
                    .Item(txt)(i) = a(i, 4)
                End If
            Next
            For i = 2 To UBound(a, 1)
                'colonne D
                If a(i, 4) < 0 Then
                    'txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))'colonnes A et B
                    txt = a(i, 1)    'colonne A
                    If .exists(txt) Then
                        For Each e In .Item(txt).keys
                            If a(i, 4) + .Item(txt)(e) = 0 Then
                                If x Is Nothing Then
                                    Set x = Union(Rows(i), Rows(e))
                                Else
                                    Set x = Union(x, Rows(e), Rows(i))
                                End If
                                .Item(txt).Remove e: Exit For
                            End If
                        Next
                    End If
                End If
            Next
        End With
        'If Not x Is Nothing Then x.EntireRow.Delete 'supprime
        'colorie
        If Not x Is Nothing Then x.EntireRow.Interior.ColorIndex = 42
    End With
End Sub

klin89

job75 · 18 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonsoir Targui,

Avec un tableau de plusieurs milliers de lignes, des formules complexes avec SOMMEPROD prendraient un temps fou.

Croyez-moi il faut du VBA.

La macro de mon post #4 étant trop lente, j'ai ajouté des tris :

Code:

Private Sub Worksheet_Activate()
Dim col%, nlig&, ncol%, t, i&, s$, x$, v, j&
col = 6 'n° de colonne des montants, à adapter
Application.ScreenUpdating = False
With Feuil1.[A1].CurrentRegion 'à adapter
  nlig = .Rows.Count
  ncol = .Columns.Count + 2 '2 colonnes auxiliaires
  Cells.ClearContents 'RAZ
  [A1].Resize(nlig, ncol - 2) = .Value 'copie des valeurs
End With
With [A1].Resize(nlig, ncol)
  t = .Value
  '---préparation---
  For i = 1 To nlig
    t(i, ncol) = i 'n° d'ordre
    If t(i, col) < 0 Then t(i, ncol - 1) = -t(i, col) _
      Else t(i, ncol - 1) = t(i, col) 'valeur absolue
  Next i
  .Value = t
  .Sort .Columns(1), , .Columns(ncol - 1), , xlAscending, Header:=xlYes '1er tri
  t = .Value
  '---repérage des paires par effacement du n° d'ordre---
  s = Chr(1)
  For i = 2 To nlig
    If t(i, ncol) = "" Then GoTo 1
    x = t(i, 1) & s & t(i, ncol - 1)
    v = t(i, col)
    For j = i + 1 To nlig
      If x <> t(j, 1) & s & t(j, ncol - 1) Then GoTo 1
      If v <> t(j, col) And t(j, ncol) <> "" Then _
        t(i, ncol) = "": t(j, ncol) = "": GoTo 1 'repérage
    Next j
1 Next i
  .Value = t
  .Sort .Columns(ncol), xlAscending '2ème tri
  '---suppression des paires---
  On Error Resume Next
  .Columns(ncol).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  '---suppression des colonnes auxiliaires---
  .Columns(ncol - 1).Resize(, 2).Delete
End With
With Me.UsedRange: End With 'actualisation des barres de défilement
End Sub

Notez qu'il y a 3 colonnes avec des montants, je n'utilise que la colonne F (6).

Fichier joint.

J'ai recopié le tableau sur 7000 lignes : la macro s'exécute chez moi en 2,5 secondes.

A+

job75 · 18 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Re,

Dans ce fichier (2) j'ai ajouté la feuille "Supprimé".

La macro est maintenant dans le code de "Feuil1" :

Code:

Sub Journal()
'se lance par Ctrl+A
Dim col%, F1 As Worksheet, F2 As Worksheet, nlig&, ncol%, t, i&, s$, x$, v, j&
col = 6 'n° de colonne des montants, à adapter
Set F1 = Sheets("Journal") 'nom à adapter
Set F2 = Sheets("Supprimé") 'nom à adapter
Application.ScreenUpdating = False
F1.Rows("2:" & F1.Rows.Count).Delete 'RAZ
F2.Rows("2:" & F2.Rows.Count).Delete 'RAZ
With [A1].CurrentRegion
  nlig = .Rows.Count
  ncol = .Columns.Count + 2 '2 colonnes auxiliaires
  F1.[A1].Resize(nlig, ncol - 2) = .Value 'copie des valeurs
End With
With F1.[A1].Resize(nlig, ncol)
  t = .Value
  '---préparation---
  For i = 1 To nlig
    t(i, ncol) = i 'n° d'ordre
    If t(i, col) < 0 Then t(i, ncol - 1) = -t(i, col) _
      Else t(i, ncol - 1) = t(i, col) 'valeur absolue
  Next i
  .Value = t
  .Sort .Columns(1), , .Columns(ncol - 1), , xlAscending, Header:=xlYes '1er tri
  t = .Value
  '---repérage des paires par effacement du n° d'ordre---
  s = Chr(1)
  For i = 2 To nlig
    If t(i, ncol) = "" Then GoTo 1
    x = t(i, 1) & s & t(i, ncol - 1)
    v = t(i, col)
    For j = i + 1 To nlig
      If x <> t(j, 1) & s & t(j, ncol - 1) Then GoTo 1
      If v <> t(j, col) And t(j, ncol) <> "" Then _
        t(i, ncol) = "": t(j, ncol) = "": GoTo 1 'repérage
    Next j
1 Next i
  .Value = t
  .Sort .Columns(ncol), xlAscending '2ème tri
  '---copie et suppression des paires---
  On Error Resume Next
  With .Columns(ncol).SpecialCells(xlCellTypeBlanks).EntireRow
    F2.[A2].Resize(.Rows.Count, ncol - 2) = .Resize(, ncol - 2).Value 'copie des valeurs
    .Delete
  End With
  '---suppression des colonnes auxiliaires---
  .Columns(ncol - 1).Resize(, 2).Delete
End With
'---actualisation des barres de défilement---
With F1.UsedRange: End With: With F2.UsedRange: End With
MsgBox "Les feuilles '" & F1.Name & "' et '" & F2.Name & "' ont été mises à jour"
End Sub

A+

job75 · 19 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonjour Targui, le forum,

Une solution meilleure qui utilise un comptage des négatifs et positifs :

Code:

Sub Journal()
'se lance par Ctrl+A
Dim col%, F1 As Worksheet, F2 As Worksheet, nlig&, ncol%
Dim colaux1%, colaux2%, t, i&, lig&, neg&, pos&, n&
col = 6 'n° de colonne des montants, à adapter
Set F1 = Sheets("Journal") 'nom à adapter
Set F2 = Sheets("Supprimé") 'nom à adapter
Application.ScreenUpdating = False
F1.Rows("2:" & F1.Rows.Count).Delete 'RAZ
F2.Rows("2:" & F2.Rows.Count).Delete 'RAZ
With [A1].CurrentRegion
  nlig = .Rows.Count
  ncol = .Columns.Count + 3 '3 colonnes auxiliaires
  colaux1 = ncol - 2: colaux2 = ncol - 1
  F1.[A1].Resize(nlig, ncol - 3) = .Value 'copie des valeurs
End With
With F1.[A1].Resize(nlig, ncol)
  t = .Value
  '---préparation---
  For i = 1 To nlig
    t(i, ncol) = i 'n° d'ordre
    If t(i, col) < 0 Then t(i, colaux1) = -t(i, col) _
      Else t(i, colaux1) = t(i, col) 'valeur absolue
  Next i
  .Value = t
  .Sort .Columns(1), , .Columns(colaux1), Header:=xlYes '1er tri
  t = .Value
    '---comptage des négatifs et positifs---
  lig = 1
  For i = 2 To nlig
    If t(i, 1) <> t(i - 1, 1) Or t(i, colaux1) <> t(i - 1, colaux1) Then
      t(lig, colaux2) = IIf(neg < pos, neg, pos)
      lig = i: neg = 0: pos = 0
    End If
    If t(i, col) < 0 Then neg = neg + 1 Else pos = pos + 1
  Next i
  t(lig, colaux2) = IIf(neg < pos, neg, pos)
  '---repérage des paires par effacement du n° d'ordre---
  For i = 2 To nlig
    If t(i, colaux2) Then n = t(i, colaux2): neg = 0: pos = 0
    If t(i, col) < 0 Then
      If neg < n Then t(i, ncol) = "": neg = neg + 1
    Else
      If pos < n Then t(i, ncol) = "": pos = pos + 1
    End If
  Next i
  .Value = t
  .Sort .Columns(ncol), xlAscending '2ème tri
  '---copie et suppression des paires---
  On Error Resume Next
  With .Columns(ncol).SpecialCells(xlCellTypeBlanks).EntireRow
    F2.[A2].Resize(.Rows.Count, ncol - 3) = .Resize(, ncol - 3).Value 'copie des valeurs
    .Delete
  End With
  '---suppression des colonnes auxiliaires---
  .Columns(colaux1).Resize(, 3).Delete
End With
'---actualisation des barres de défilement---
With F1.UsedRange: End With: With F2.UsedRange: End With
MsgBox "Les feuilles '" & F1.Name & "' et '" & F2.Name & "' ont été mises à jour"
End Sub

Il n'y a plus d'imbrication de boucles, l'exécution sur 7000 lignes prend 1,4 seconde.

Fichier (3).

A+

JCGL · 19 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonjour à tous,
salut Gérard,

A++ mon ami

A+ à tous

job75 · 19 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonjour Jean-Claude,

J'ai remis au post #10 le même fichier (3) , peux-tu me dire si il passe ?

Et dans la foulée vérifie stp les fichiers (1) et (2), merci mon ami.

A+

JCGL · 19 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonjour à tous,

C'est tout bon pour les 3
J'attends la version (10)... Qui prendra 0.0001 seconde... Pour engranger dans mon grenier.

Arf... Arf...

A++ mon
A+ à tous

job75 · 19 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Re,

JCGL à dit:
J'attends la version (10)... Qui prendra 0.0001 seconde... Pour engranger dans mon grenier.

Tu as raison, avec des Dictionary j'arrive à 0,8 seconde sur 7000 lignes.

La copie d'une seule colonne avec Application.Index a fait gagner 0,2 seconde.

Code:

Sub Journal()
'se lance par Ctrl+A
Dim col%, F1 As Worksheet, F2 As Worksheet, nlig&, ncol%, colaux%, t
Dim dneg As Object, dpos As Object, s$, i&, x$, dneg1 As Object, dpos1 As Object, n&
col = 6 'n° de colonne des montants, à adapter
Set F1 = Sheets("Journal") 'nom à adapter
Set F2 = Sheets("Supprimé") 'nom à adapter
Application.ScreenUpdating = False
F1.Rows("2:" & F1.Rows.Count).Delete 'RAZ
F2.Rows("2:" & F2.Rows.Count).Delete 'RAZ
With [A1].CurrentRegion
  nlig = .Rows.Count
  ncol = .Columns.Count + 2 '2 colonnes auxiliaires
  colaux = ncol - 1
  F1.[A1].Resize(nlig, ncol - 2) = .Value 'copie des valeurs
End With
With F1.[A1].Resize(nlig, ncol)
  t = .Value
  '---comptage des négatifs et positifs---
  Set dneg = CreateObject("Scripting.Dictionary")
  Set dpos = CreateObject("Scripting.Dictionary")
  s = Chr(1)
  For i = 1 To nlig
    x = t(i, 1) & s & Replace(t(i, col), "-", "")
    t(i, ncol) = x 'mémorisation
    If t(i, col) < 0 Then dneg(x) = dneg(x) + 1 Else dpos(x) = dpos(x) + 1
  Next i
  '---repérage des non-paires---
  Set dneg1 = CreateObject("Scripting.Dictionary")
  Set dpos1 = CreateObject("Scripting.Dictionary")
  For i = 1 To nlig
    x = t(i, ncol)
    n = IIf(dneg(x) < dpos(x), dneg(x), dpos(x))
    If t(i, col) < 0 Then
      If dneg1(x) < n Then dneg1(x) = dneg1(x) + 1 Else t(i, colaux) = 1 'repérage
    Else
      If dpos1(x) < n Then dpos1(x) = dpos1(x) + 1 Else t(i, colaux) = 1 'repérage
    End If
  Next i
  .Columns(colaux) = Application.Index(t, , colaux)
  .Resize(, colaux).Sort .Columns(colaux) 'tri
  '---copie et suppression des paires---
  On Error Resume Next
  With .Columns(colaux).SpecialCells(xlCellTypeBlanks).EntireRow
    F2.[A2].Resize(.Rows.Count, ncol - 2) = .Resize(, ncol - 2).Value 'copie des valeurs
    .Delete
  End With
  '---suppression de la colonne auxiliaire---
  .Columns(colaux).Delete
End With
'---actualisation des barres de défilement---
With F1.UsedRange: End With: With F2.UsedRange: End With
MsgBox "Les feuilles '" & F1.Name & "' et '" & F2.Name & "' ont été mises à jour"
End Sub

Edit : sur 7000 lignes les boucles de comptage et de repérage ne prennent que 0,06 seconde...

Et les copies, le tri, les suppressions ne sont guère compressibles.

Fichier joint.

Bonne fin de soirée.

mapomme · 20 Février 2016

Re : Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

Bonjour à tous

,

Comme j'avais commencé un truc, je termine...

J'utilise comme clef le champ "Account" (colonne A) et comme montant le champ "USD Amount" (colonne D).

Sur ma vieille bécane chérie (mai 2007! Bientôt neuf bougies à souffler !), pour environ 50 000 lignes, la durée oscille autour de 2.6 sec.

Si vous pouviez m'indiquer des durées pour un PC récent, ça m'inciterait peut-être à m'en séparer pour un nouveau... (le mois de mai serait tout indiqué, c'est notre anniversaire à tous les deux - nonobstant le fait qu'il soit six fois moins vieux que moi

)

Le code est un tout petit peu commenté.

XL 2013 Formule Excel pour annuler/extraire les écritures qui s'annulent entre elles.

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Partager cette page

Statistiques des forums