Code pour gerer mes rapprochements

Salut à tous

Permettez que j'aille droit au but.

J'ai une plage de donnée qui contient des informations sur mes mouvements bancaires.

J'ai paqs encore trouvé un bon identifiant pour être sûr que les montants à appurer seront les bons.

Pour le moment, je n'ai qu'un seul critère même s'il n'est pas pour le moment très pertinent.

Voici comment je souhaite procéder :

S'il y'a un montant au débit(colonne F) et son contraire au crédit(colonne G), que la ligne du débit et du crédit correspondant soient supprimés.

Je reste à votre disposition pour des informations complémentaires.

Ex : 100 000 à pour contraire -100 000 dans mon cas

N.B : ne faites pas attention aux éléments de la colonne E.

193mes-donnees.xlsx (131.92 Ko)

Salut à tous

Juste pour partager avec vous le résultat de mon sujet.

J'ai eu un coup de main et je souhaite que ca puisse être profitable aux forumaires de Excel-bva que j'apprécie beaucoup.

Le code ci-dessous qui m'a été proposé répond bien à mes attentes.

Sub Rapprochement()
Dim Nb As Long, i As Long, j As Long, k As Long
Dim Tb

Application.ScreenUpdating = False
With Feuil1
    Nb = .Cells(.Rows.Count, "A").End(xlUp).Row - 2
    If Nb > 0 Then
        Tb = .Range("A3").Resize(Nb, 8).Value

        For i = 1 To Nb - 1
            If Tb(i, 8) = Empty And Abs(Tb(i, 6)) > 0 Then
                For j = i + 1 To Nb
                    If Tb(j, 8) = Empty And Abs(Tb(j, 7)) > 0 Then
                        If Abs(Abs(Tb(i, 6)) - Abs(Tb(j, 7))) < 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("A3").Resize(Nb, 8).Value = Tb
        .Range("A3").Resize(Nb, 8).Sort Key1:=.Range("H3"), Order1:=xlAscending, Header:=xlNo
    End If
End With
End Sub
Rechercher des sujets similaires à "code gerer mes rapprochements"