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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
| Option Explicit
Sub RapprochementBis()
Dim Nb As Long, i As Long, j As Long, k As Long, n As Long, p As Long, Deb As Long, Tmp As Long
Dim OpDeb As String, OpCred As String, CliDeb As String, CliCred As String
Dim Debit, Credit
Dim S As Double
Dim c As Range
Application.ScreenUpdating = False
With Worksheets(1)
'nombre de lignes utilisées sur colonne A
Nb = .Cells(.Rows.Count, 1).End(xlUp).Row
If Nb > 2 Then
'On efface la colonne F
.Range("F2:F" & Nb).ClearContents
'On tri le tableau sur montants crédits ensuite débit
.Range("A2:F" & Nb).Sort Key1:=.Range("D2"), Order1:=xlDescending, Key2:=.Range("E2"), Order1:=xlDescending, Header:=xlNo
'On cherche la première ligne Credit
Set c = .Range("E2:E" & Nb).Find("*", LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
Deb = c.Row
Set c = Nothing
If Deb > 2 Then
'On travaille avec 2 variables tableaux (on y ajoute aussi la colonne F qui devait être vide)
Debit = .Range("A2:F" & Deb - 1)
Credit = .Range("A" & Deb & ":F" & Nb)
'On parcourt toutes les enregistrements du tableau Tb (hormis le drnier enregistrement)
For i = 1 To Deb - 2
'Si le 6ème champs (colonne F) est vide, càd non encore traitée
If IsEmpty(Debit(i, 6)) Then
'On récupère à l'aide de la fonction ci-dessous le n° de l'opération dans la variable Op
OpDeb = Debit(i, 2)
'On récupère ensuite à l'aide de la seconde fonction ci-dessous le n° du client dans la variable Client
CliDeb = NumClient(Debit(i, 3))
'On boucle sur les enregistrements suivants
For j = 1 To Nb - Deb + 1
'Si le 6ème champs (colonne F) est vide, càd non encore traitée
If IsEmpty(Credit(j, 6)) Then
OpCred = NumOp(Credit(j, 3))
CliCred = NumClient(Credit(j, 3))
'si on a les mêmes clients et opérations entre credit et debit
If OpDeb = OpCred And CliDeb = CliCred Then
If Tmp = 0 Then Tmp = j
'on cumul les crédits
S = S + Credit(j, 5)
'et on marque la ligne par -1 en 6ème colonne
Credit(j, 6) = -1
'si la valeur débit est soldée par la somme S des valeurs crédits
If Abs(S - Debit(i, 4)) < 0.01 Then
'on incrémente le compteur de compte soldés k
k = k + 1
'et on inscrit ce compteur dans la colonne F au niveau de la ligne i debit
Debit(i, 6) = k
'et dans toutes les lignes n marquée par notre -1
For n = Tmp To j
If Credit(n, 6) = -1 Then Credit(n, 6) = k
Next n
'et on sort de la boucle
Exit For
End If
End If
End If
Next j
'On supprime les indicteurs -1 au cas où on a pas trouvé de rapprochment
p = Application.Min(j, Nb - Deb + 1)
If Tmp = 0 Then Tmp = p
For n = Tmp To p
If Credit(n, 6) = -1 Then Credit(n, 6) = Empty
Next n
'on réinitialise les variables de cumul
S = 0
Tmp = 0
End If
Next i
'après traitement de toutes les lignes, les Tableaux Debit et Credit sont entièrement traités au niveau du remplissage du 6ème champs par le N° de compte
.Range("A2:F" & Deb - 1) = Debit
.Range("A" & Deb & ":F" & Nb) = Credit
'On tri la plage
.Range("A2:F" & Nb).Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:=xlNo
End If
End If
End If
End With
MsgBox "Rapprochment terminé"
End Sub
'Fonction qui permet d'extraire le n° de l'opération éventuelle à partir du libellé
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
'Fonction qui permet d'extraire le n° du client en fonction de la nature du libellé
Private Function NumClient(ByVal Str As String) As String
Dim n As Integer
Dim Tmp As String
n = InStr(Str, "OP")
If n > 0 Then
Tmp = Trim(Left(Str, n - 1))
If InStr(Tmp, "-") Then Tmp = Split(Tmp, "-")(0)
NumClient = Tmp
Else
n = InStr(Str, "APP")
If n > 0 Then NumClient = Mid(Str, n)
End If
End Function |
automatisation Rapprochement bancaire
Répondre avec citation
Partager