Discussion :

[zealot37]

Bonjour à tous,

Ayant lu pas mal de fil à ce sujet, je viens vous solliciter pour un peu d'aide (un défi pour moi...)

Je dois rapprocher débit/crédit, comme c'est souvent le cas, mais je bloque sur la façon de faire, je m'explique :

5 colonnes => journal, n° opération, libellé, débit, crédit
journal : 2 valeurs possibles, "LOAD" et "IG & UK"
LOAD => ce qui est en banque (uniquement crédit)
IG & UK => ce qui est en attente (débit ou crédit si annulation, donc à rapprocher si annulation dans le meme journal) ou à rapprocher avec LOAD

le journal LOAD à un n° opération distinct
dans le libellé des lignes LOAD, on retourve le n° d'opération des lignes IG&UK et le n° client est commun aux libellé des lignes LOAD et IG&UK...

ce n'est pas très facile à expliquer, dites moi si un fichier pourrai aider...

Merci pour votre aide, je suis perdu...

[QuestVba]

Bonjour,

Je suis pas certain d'avoir tout compris. Pour éviter tout malentendu, peux-tu joindre un fichier.

[zealot37]

Bonjour QuestVba

voici le fichier avec quelques explications à l'intérieur.

Merci

[Sogestion]

Bonsoir,

Voici un code que vous pourriez peut être adapter à vos besoins

Ce code effectue le rapprochement sur base Débit/Crédit d'un même montant

Code testé sur votre fichier

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
Sub Rapprochement()
 
    Dim Nb As Long, i As Long, j As Long, k As Long
    Dim Tb
 
    Application.ScreenUpdating = False
    With Worksheets("NOVEMBRE")
        Nb = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
        If Nb > 0 Then
            Tb = .Range("A2").Resize(Nb, 8).Value
 
            For i = 1 To Nb
                If Tb(i, 8) = Empty And Abs(Tb(i, 4)) > 0 Then
                    For j = 1 To Nb
                        If Tb(j, 8) = Empty And Abs(Tb(j, 5)) > 0 Then
                            If Abs(Abs(Tb(i, 4)) - Abs(Tb(j, 5))) < 0.0000000001 Then
                                k = k + 1
                                Tb(i, 8) = k
                                Tb(j, 8) = k
                                Exit For
                            End If
                        End If
                    Next j
                End If
            Next i
 
            .Range("A2").Resize(Nb, 8).Value = Tb
            .Range("A2").Resize(Nb, 8).Sort Key1:=.Range("H3"), Order1:=xlAscending, Header:=xlNo
        End If
    End With
End Sub

_______________
Cordialement

[zealot37]

Bonsoir Sogestion,

en effet le code fonctionne parfaitement pour rapprocher les montant identiques, malheureusement j'ai, dans mon classeur original, trop de montants identiques pour que ce code fonctionne de manière optimale.

Il faudrait rajouter, pour les montants identiques une condition entre les 5 derniers caractères du libellé (colonne C) des lignes qui ont en colonne A "LOAD", et le numéro "OP" (colonne B) des lignes qui ont en colonne A "IG&UK" pour que cela se rapproche de ce que j'essai de faire... encore que si il s'agit d'une annulation, ce serait deux lignes qui en colonne A aurait IG&UK avec un même libellé mais une numéro OP différent (et bien des montant identiques, un au crédit l'autre au débit)...

Bref, un vrai casse-tête

[mercatog]

Je suppose qu'on est avec les même montants débit et crédit sur une même opération d'un même client et qu'on est avec une seule ligne par opération.
C'est mon hypothèse (à confirmer ou infirmer)

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
Sub Rapprochement()
Dim Nb As Long, i As Long, j As Long, k As Long
Dim Op As String, Client As String
Dim Tb
 
Application.ScreenUpdating = False
With Worksheets(1)
    Nb = .Cells(.Rows.Count, 1).End(xlUp).Row
    Tb = .Range("A2:F" & Nb)
    For i = 1 To Nb - 2
        If IsEmpty(Tb(i, 5)) Then
            If IsEmpty(Tb(i, 6)) Then
                Op = NumOp(Tb(i, 3))
                Client = NumClient(Tb(i, 3))
                For j = i + 1 To Nb - 1
                    If IsEmpty(Tb(j, 6)) Then
                        If Tb(j, 1) <> "LOAD" Then
                            If Tb(j, 2) = Op And NumClient(Tb(j, 3)) = Client Then
                                k = k + 1
                                Tb(i, 6) = k
                                Tb(j, 6) = k
                                Exit For
                            End If
                        End If
                    End If
                Next j
            End If
        End If
    Next i
    .Range("A2:F" & Nb) = Tb
    .Range("A2:F" & Nb).Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:=xlNo
End With
MsgBox "Rapprochment terminé"
End Sub
 
Private Function NumOp(ByVal Str As String) As String
Dim n As Integer
 
n = InStr(Str, "OP")
If n > 0 Then NumOp = Mid(Str, n + 2)
End Function
 
Private Function NumClient(ByVal Str As String) As String
Dim n As Integer
 
n = InStr(Str, "OP")
If n > 0 Then
    NumClient = Trim(Left(Str, n - 1))
Else
    n = InStr(Str, "APP")
    If n > 0 Then NumClient = Mid(Str, n)
End If
End Function