Code rapprochement (2)

Ce code fait le rapprochement des écritures par leur montant en tenant compte d’une partie du libellé

*****************************************************************

***********************************************************************

‘NB: Les informations precédées du signe ‘ sont des commentaires
‘Elles ne sont pas considérées dans l’exécution du code
‘Ce code ne concerne que sur les opérations au crédit. Il est facilement adaptable pour les opérations au débit
‘Pour rapprocher une écriture,Il prend en compte non seulement le montant
‘mais également un element du libellé des opérations NS
‘qui doit correspondre avec un element du libellé des opérations AS.

Sub Rapprochement_Credit_New()

‘Cette macro fait le rapprochement des montants nouveau système (NS) et ceux de ancien système (AS)
‘macro écrite par calvin, le 29 avril 2007
‘les montants rapprochés sont coloriés en vert
Rem NB: Avant d’utiliser ce code, il est conseillé de mettre les montants sous format de séparateur de milliers

Dim i As Long
Dim j As Long
Dim k As Integer
Dim m As Integer
Dim Montant, NumeroAS, NumeroNS ‘As Double
Dim TableauNS() As String
Dim TableauAS() As String

 With ActiveSheet ‘Le code devrait marcher pour la feuille active

    For j = 2 To 600 ‘debut de la boucle sur les montant AS
   
        Montant = Cells(j, 11) ‘Recupération de la valeur AS dans cette variable (colonne K, ie n°11)
       
       
            For i = 2 To 600 ‘debut de la boucle sur les montant NS au débit
               
                ‘ la fonction Split divise une chaine en fonction des espaces Ex: Plit(”je suis en vie”, ” “), aura en sortie : | je | suis | en | vie |
                ‘ Puis on conserve le résultat dans un tableau
               
                TableauNS = Split(Cells(i, 4).Offset(0, -2), ” “) ‘Fonction dans la colonne des libellés NS
                TableauAS = Split(Cells(j, 11).Offset(0, 2), ” “) ‘Fonction dans la colonne des libellés AS
               
                    For k = 0 To UBound(TableauNS) ‘Boucle sur le tableau NS
                       
                        For m = 0 To UBound(TableauAS) ‘Boucle sur le tableau AS
                       
                            ‘Condition si le montant AS correspond au montant NS (colonne C, ie n°3)
                            ‘Et une partie du libellé AS  est contenu dans une partie du libellé de NS
                           
                             If Cells(i, 4) = Montant _
                             And TableauAS(m) = TableauNS(k) _
                             And Cells(i, 4).Interior.ColorIndex <> 4 _
                             And Cells(j, 11).Interior.ColorIndex <> 4 _
                             And Imput = “C” Then ‘Condition si le montant AS correspond au montant NS (colonne D, ie n°4)
                                    Cells(i, 4).Interior.ColorIndex = 4 ‘Colorier la cellule du montant NS
                                    Cells(j, 11).Interior.ColorIndex = 4 ‘Colorier la cellule du montant AS
               
                                End If ‘Fin de la condition
                               
                        Next m ‘increment de la cellule du tableau AS
                       
                    Next k ‘increment de la cellule du tableau NS
                   
            Next i ‘increment de la cellule suivante des montants NS
   
    Next j  ‘increment de la cellule suivante des montants AS
   
 End With ‘Fin Feuille active
 
 MsgBox “Lettrage des montants au crédit terminé”, vbInformation, “Lettrage ” ‘Message qui indique la fin du lettrage
 
End Sub