Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Lettrage automatique

C

chermiti

XLDnaute Occasionnel
bonjour les amis,

j'ai un fichier excel qui regroupe les débit et les crédits, mon travail consiste à balancer chaque paiement avec les factures respectives, je fais ce travail manuellement mais il me prend beaucoup de temps, pouvez vous s'il vous plait m'aider pour trouver une application ou une macro afin de faire le lettrage comme mentionnée dans le fichier ci joint

merci d'avance
 

Pièces jointes

  • LETTRAGE AUTOMATIQUE.xlsx
    36.1 KB · Affichages: 948
Trier par date Trier par votes

Annette

XLDnaute Occasionnel
Re : Lettrage automatique

Bonsoir job75, bonsoir le forum,

Ne connaissant pas du tout le système de lettrage, j'ai pu à travers différents fils en comprendre l’intérêt et la difficulté.
J'ai essayé votre (super ) macro et souhaite comprendre le principe des "nombres de lignes précédentes étudiées", car, si je peux me permettre, avec 24 lignes paramétrables et 2000000 d'itérations, la macro "ne trouve pas" la combinaison dans l'exemple des lignes jaunes du fichier de chermiti en post 8.
Faut-il augmenter le nombre de lignes (je ne crois pas car 24 lignes débit précèdent la ligne 27) ou faut-il augmenter le nombre d'itérations ?

Merci pour votre réponse.

Cordialement
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Re : Lettrage automatique

Bonsoir Annette,

Pour ce qui est du crédit de la ligne 289 du fichier de chermiti, on le trouve facilement avec mon fichier du post #15.

Par contre pour le crédit en ligne 27 il faut impérativement nlig = 25.

Or 2^25 = 33 554 432.

Pour avoir une chance de le trouver il faut au moins nit = 10 000 000 ou 20 000 000...

Je vous laisse tester mais pour arrêter au plus tôt la macro modifiez le code :

Code: 
'-----
    If s = credit(i, 1) Then
      n = n + 1
      lettrage(i, 1) = 1
      P(i, "H") = n
      For j = 1 To ub
        If a(j) Then
          lettrage(i - j, 1) = 1
          P(i - j, "H") = n
        End If
      Next
      Exit For 'pour arrêter au plus tôt
    End If
Bonne nuit et A+
 
Vote positif 0 Vote négatif

Annette

XLDnaute Occasionnel
Re : Lettrage automatique

job75,

Merci pour votre réponse.
Je viens de lancer la macro avec 25 lignes et 36000000 itérations et les ligne 26 et 27 retournent pas trouvé.
En revanche je ne comprends pas l'histoire du nombre de lignes: je tente de m'expliquer:
Si pour la ligne 27 il faut rentrer 25 lignes, théoriquement pour la ligne 29, il faudrait changer ce chiffre et l'augmenter à 27 ?

Merci pour votre réponse

Bonne nuit également

Cordialement
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Re : Lettrage automatique

Bonjour le fil, le forum,

Ah ben ça alors, sur le fichier de chermiti testez :

Code: 
Sub test1()
Dim x#, s#
x = [F27]
s = [E19] + [E18] + [E15] + [E14] + [E2]
MsgBox x
MsgBox s
MsgBox x = s
End Sub
la 3ème MsgBox renvoie FAUX.

Pas de problème si l'on met des CDbl :

Code: 
Sub test2()
Dim x#, s#
x = [F27]
s = CDbl([E19]) + CDbl([E18]) + CDbl([E15]) + CDbl([E14]) + CDbl([E2])
MsgBox x
MsgBox s
MsgBox x = s
End Sub
Alors testez cette macro :

Code: 
Sub Rapprochement()
Dim durée#, nlig%, nit&, P As Range, debit, credit, lettrage
Dim i&, it&, ub%, a() As Byte, s#, j%, n&
durée = Timer
Randomize
nlig = 25 'nombres de lignes précédentes étudiées, paramétrable
nit = 30000000 'nombre maximum d'itérations, paramétrable
Set P = ActiveSheet.UsedRange
P.Sort ActiveSheet.[A1], xlAscending, Header:=xlYes 'tri par dates
debit = P.Columns("E") 'matrice, plus rapide
credit = P.Columns("F")
P.Columns("H").Offset(1) = "" 'RAZ
lettrage = P.Columns("H")
For i = 2 To P.Rows.Count
  If credit(i, 1) > 0 Then
    it = 0
    ub = IIf(i > nlig + 1, nlig, i - 2)
1   ReDim a(1 To ub) 'RAZ
    s = 0
    For j = 1 To ub
      If lettrage(i - j, 1) = "" Then
        If Rnd > 0.5 Then
          a(j) = 1
          s = s + CDbl(debit(i - j, 1))
          If s > credit(i, 1) Then Exit For
        End If
      End If
    Next
    If s = credit(i, 1) Then
      n = n + 1
      lettrage(i, 1) = 1
      P(i, "H") = n
      For j = 1 To ub
        If a(j) Then
          lettrage(i - j, 1) = 1
          P(i - j, "H") = n
        End If
      Next
      Exit For 'GoTo 2 'pour sortir plus tôt
    End If
    If it = nit Then
      lettrage(i, 1) = 1
      P(i, "H") = "Pas trouvé"
      GoTo 2
     End If
    it = it + 1
    GoTo 1
  End If
2 Next
MsgBox "Durée " & Format(Timer - durée, "0.0 \s")
End Sub
A+
 
Vote positif 0 Vote négatif

Annette

XLDnaute Occasionnel
Re : Lettrage automatique

Bonjour job75, bonjour le forum,

job75 à dit:
Re,

C'est pourtant simple, la macro étudie, comme je l'ai dit, nlig au dessus du crédit, un point c'est tout.

A+
Cliquez pour agrandir...

Veuillez m'excuser de tenter de comprendre la logique de votre macro. Je pense que ma question est pertinente et si vous trouvez que non, merci d'y répondre avec moins du rugosité...

Cordialement
 
Vote positif 0 Vote négatif

Annette

XLDnaute Occasionnel
Re : Lettrage automatique

Job75,

Je ne remets nullement en cause vos compétences qui me dépassent de loin. Comme précédemment dit, je teste, fais remonter de l'info et tente juste de comprendre ... En ce qui me concerne, j'estime que votre réponse était "inadaptée" à mes questions, tout simplement.
Il faut croire que nous avions rendez-vous ce matin à cette heure-ci car lorsque j'ai commencé ma réponse, vous veniez de poster la votre. Pour votre post 21 je teste la macro dès que possible (évidemment qu'il est intéressant ).

Cordialement
 
Vote positif 0 Vote négatif

Annette

XLDnaute Occasionnel
Re : Lettrage automatique

Job75,

J'en arrive à la même conclusion que vous... sauf que moi j'en sais encore moins .
En revanche, j'ai changé les valeurs crédit (ligne 26 et 27) et débit (faire en sorte que l'addition de certaines sommes correspondent) et la macro (paramétrée avec 25 lignes et 36 000 000 itérations) fait le travail (je précise que les nombres sont entiers et que je me sers du fichier post 15)
Je continue de tester.

Cordialement
 
Vote positif 0 Vote négatif

Annette

XLDnaute Occasionnel
Re : Lettrage automatique

J'ai refait un test avec des nombres décimaux (mêmes paramètres) et le résultat n'est pas le même, à savoir:
Crédit F27 trouvé mais pas le précédent.
l'énigme à l'air d'être bien compliquée

Cordialement

Edition: deux nouveaux essais:
Paramètres 24 lignes ( F26 et F27 pas trouvé)
Paramètres 26 lignes (idem test avec 25 lignes)
 

Pièces jointes

  • Rapprochement comptable2.xlsm
    53.3 KB · Affichages: 59
Dernière édition:
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Re : Lettrage automatique

Bonjour le fil, le forum,

Voici une tout autre méthode qui étudie toutes les combinaisons jusqu'à un maximum de 5 débits :

Code: 
Sub Rapprochement()
'permet de rapprocher jusqu'à 5 débits
Dim durée#, P As Range, debit, credit, lettrage
Dim i&, cred As Single, a&, n&, b&, c&, d&, e&, f&
durée = Timer
Set P = ActiveSheet.UsedRange
P.Sort ActiveSheet.[A1], xlAscending, Header:=xlYes 'tri par dates
debit = P.Columns("E") 'matrice, plus rapide
credit = P.Columns("F")
P.Columns("H").Offset(1) = "" 'RAZ
lettrage = P.Columns("H")
For i = 2 To P.Rows.Count
  If credit(i, 1) > 0 Then
    cred = credit(i, 1)
    '---1 débit---
    For a = 2 To i - 1
      If lettrage(a, 1) = 1 Then GoTo 2
      If CSng(debit(a, 1)) <> cred Then GoTo 2
      n = n + 1
      lettrage(i, 1) = 1
      lettrage(a, 1) = 1
      P(i, "H") = n
      P(a, "H") = n
      GoTo 1
2   Next a
    '---2 débits---
    For a = 2 To i - 2
      If lettrage(a, 1) = 1 Then GoTo 3
      For b = a + 1 To i - 1
        If lettrage(b, 1) = 1 Then GoTo 4
        If CSng(debit(a, 1) + debit(b, 1)) <> cred Then GoTo 4
        n = n + 1
        lettrage(i, 1) = 1
        lettrage(a, 1) = 1
        lettrage(b, 1) = 1
        P(i, "H") = n
        P(a, "H") = n
        P(b, "H") = n
        GoTo 1
4     Next b
3   Next a
    '---3 débits---
    For a = 2 To i - 3
      If lettrage(a, 1) = 1 Then GoTo 5
      For b = a + 1 To i - 2
        If lettrage(b, 1) = 1 Then GoTo 6
        For c = b + 1 To i - 1
          If lettrage(c, 1) = 1 Then GoTo 7
          If CSng(debit(a, 1) + debit(b, 1) + _
            debit(c, 1)) <> cred Then GoTo 7
          n = n + 1
          lettrage(i, 1) = 1
          lettrage(a, 1) = 1
          lettrage(b, 1) = 1
          lettrage(c, 1) = 1
          P(i, "H") = n
          P(a, "H") = n
          P(b, "H") = n
          P(c, "H") = n
          GoTo 1
7       Next c
6     Next b
5   Next a
    '---4 débits---
    For a = 2 To i - 4
      If lettrage(a, 1) = 1 Then GoTo 8
      For b = a + 1 To i - 3
        If lettrage(b, 1) = 1 Then GoTo 9
        For c = b + 1 To i - 2
          If lettrage(c, 1) = 1 Then GoTo 10
          For d = c + 1 To i - 1
            If lettrage(d, 1) = 1 Then GoTo 11
            If CSng(debit(a, 1) + debit(b, 1) + _
              debit(c, 1) + debit(d, 1)) <> cred Then GoTo 11
            n = n + 1
            lettrage(i, 1) = 1
            lettrage(a, 1) = 1
            lettrage(b, 1) = 1
            lettrage(c, 1) = 1
            lettrage(d, 1) = 1
            P(i, "H") = n
            P(a, "H") = n
            P(b, "H") = n
            P(c, "H") = n
            P(d, "H") = n
            GoTo 1
11        Next d
10      Next c
9     Next b
8   Next a
    '---5 débits---
    For a = 2 To i - 5
      If lettrage(a, 1) = 1 Then GoTo 12
      For b = a + 1 To i - 4
        If lettrage(b, 1) = 1 Then GoTo 13
        For c = b + 1 To i - 3
          If lettrage(c, 1) = 1 Then GoTo 14
          For d = c + 1 To i - 2
            If lettrage(d, 1) = 1 Then GoTo 15
            For e = d + 1 To i - 1
              If lettrage(e, 1) = 1 Then GoTo 16
              If CSng(debit(a, 1) + debit(b, 1) + _
                debit(c, 1) + debit(d, 1) + _
                  debit(e, 1)) <> cred Then GoTo 16
              n = n + 1
              lettrage(i, 1) = 1
              lettrage(a, 1) = 1
              lettrage(b, 1) = 1
              lettrage(c, 1) = 1
              lettrage(d, 1) = 1
              lettrage(e, 1) = 1
              P(i, "H") = n
              P(a, "H") = n
              P(b, "H") = n
              P(c, "H") = n
              P(d, "H") = n
              P(e, "H") = n
              GoTo 1
16          Next e
15        Next d
14      Next c
13    Next b
12  Next a
    lettrage(i, 1) = 1
    P(i, "H") = "Pas trouvé"
    DoEvents 'pour l'affichage
  End If
1 Next i
MsgBox "Durée " & Format(Timer - durée, "0.0 \s")
End Sub
25 crédits ne sont pas trouvés, bien sûr maintenant F27 est trouvé...

Fichier joint.

A+
 

Pièces jointes

  • Rapprochement comptable pour un maximum de 5 débits(1).xls
    118 KB · Affichages: 186
Vote positif 0 Vote négatif

Annette

XLDnaute Occasionnel
Re : Lettrage automatique

Bonjour job75, bonjour le forum,

N'étant pas à l'initiative de la demande, il n'en reste pas moins que ladite demande m'interpellait.
Quant au travail réalisé par job75, je dis BRAVO.
Efficacité, rapidité, c'est de la dentelle ... .
Un fichier qui ravira surement bon nombre de comptables.

Hop, dans le coffre à malices ... pour une éventuelle adaptation.

Merci à vous job75 .

Cordialement
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
Microsoft 365 Rapprochement avec Power Pivot
2 3
Réponses
33
Affichages
682
bcharef
C
  • Question
Microsoft 365 RESOLU - Compter des valeurs dans des colonnes qui contiennent 2 données
Réponses
8
Affichages
298
Cousinhub
  • Résolu(e)
XL 2016 Suivi location de voiture
Réponses
4
Affichages
465
Armisa
P
  • Question
XL 2021 Code VBA pour copier coller des données de cellules d'une feuille a une autre
Réponses
4
Affichages
580
phoceenjo
P
S
  • Question
XL 2016 Classer des valeurs selon intervalle (classes)
Réponses
4
Affichages
317
stuka
S
I
  • Résolu(e)
Microsoft 365 Lettrage débit/crédit via VBA
Réponses
10
Affichages
1 K
youky(BJ)
P
  • Question
XL 2021 code vba pour autorisez l'enregistrement par le bouton "enregistrer" uniquement si tout les champs sont remplis
2
Réponses
19
Affichages
1 K
phoceenjo
P
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
219
NONO14
N
  • Question
Microsoft 365 Teams
Réponses
7
Affichages
519
tbft
A
  • Question
Microsoft 365 Macro pour récupérer des colonnes qui ne sont pas conjointes
Réponses
4
Affichages
163
Anthony_51
A
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…