Lettrage automatique

[chermiti]

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

 

[job75]

Re : Lettrage automatique

Re,

J'ai paramétré 30 lignes et 1 000 000 d'itérations.

Sur Excel 2003 il a fallu 373 secondes.

Résultat : 42 "Pas trouvé" donc 2 de moins.

A+

 

[Annette]

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

 

[job75]

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 :

'-----
    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+

 

[Annette]

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

 

[job75]

Re : Lettrage automatique

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+

 

[job75]

Re : Lettrage automatique

Bonjour le fil, le forum,

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

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 :

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 :

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+

 

[Annette]

Re : Lettrage automatique

Bonjour job75, bonjour le forum,

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+

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

 

[job75]

Re : Lettrage automatique

Re Annette,

Rugosité , mais regardez mon post #21, ça c'est intéressant.

A+

 

[Annette]

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

 

[job75]

Re : Lettrage automatique

Re,

C'est vraiment bizarre, j'ai testé avec Cdbl, CDec, CCur, pas moyen de trouver ce fichu crédit en F27.

A+

 

[job75]

Re : Lettrage automatique

Re,

Je reviens sur le post #21.

La 3ème MsgBox de test1 renvoie VRAI si s est déclarée Single - s! - ou Currency - s@.

Pas compris pourquoi...

A+

 

[Annette]

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

 

[Annette]

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)

 

[job75]

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 :

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+

 

[Annette]

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