Détecter les doublons positif et négatif sur une même date

Bonjour j'aimerai réaliser une macro qui met en évidence les montants identiques en positif et négatif pour une même date.

En colonne B j'ai la date de l'opération et en colonne E les montants positifs et négatifs.

Merci

Bonjour,

A mon avis, votre façon de vouloir procéder me paraît insuffisante, en effet, il pourrait y avoir le même jour, plus d'une fois le même montant aussi bien en positif
qu'en négatif, il faudrait ajouter un critère supplémentaire, par exemple le libellé si c'est pour contrôler des relevés bancaires ou autre chose.

Cdlt

Bonjour,

Il ne s'agit pas de relevé bancaire et les libellés des opérations peuvent être différents. Il faudrait que j'arrive à isoler quand il y a un montant négatif sur une journée tous les montants positifs du même montant.

Merci

Alors ceci, la valeur négative est sur fond jaune et toutes les valeurs positives sont en vert.:

Sub Marquage()
    Dim DerLig As Long, DerCol As Long, i As Long, Lig As Long
    Application.ScreenUpdating = False
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    DerCol = Range("ZZ1").End(xlToLeft).Column
    Range("E2:E" & DerLig).Interior.Color = xlNone
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B2:B" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("E2:E" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1:E" & DerLig)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    For i = 2 To DerLig
        Jour = Cells(i, "B")
        Montant = Cells(i, "E")
        If Cells(i, "E") < 0 Then Cells(i, "E").Interior.ColorIndex = 6
        Lig = i
        If Montant < 0 Then
            Do While Cells(Lig, "B") = Jour
                If Cells(Lig, "E") * -1 = Montant Then
                    Cells(Lig, "E").Interior.ColorIndex = 4
                End If
                Lig = Lig + 1
            Loop
        End If
        i = Lig
    Next i
End Sub

Cdlt

Oui la formule est très bien merci beaucoup. Après j'ai remarqué que quand il y a d'autres montants négatifs avec des montants positifs identiques sur la même journée il n'en tient pas compte. Je vais voir si je trouve une solution.

Dans le fichier en PJ voir la journée du 18/05/2020 comme exemple.

Merci

Bonjour,

Oui la formule est très bien merci beaucoup. Après j'ai remarqué que quand il y a d'autres montants négatifs avec des montants positifs identiques sur la même journée il n'en tient pas compte.

Il suffit de supprimer cette ligne:

i = Lig

Cdlt

Merci c'est parfait, dernière petite amélioration, j'aimerais que quand il y a un montant négatif et qu'il n'y a pas de montant positif identique sur la journée il ne soit pas surligné en jaune.

Bonne journée

Ok, alors ceci

Sub Marquage()
    Dim DerLig As Long, DerCol As Long, i As Long, Lig As Long
    Application.ScreenUpdating = False
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    DerCol = Range("ZZ1").End(xlToLeft).Column
    Range("I2:I" & DerLig).Interior.Color = xlNone
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B2:B" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("I2:I" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1:L" & DerLig)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    For i = 2 To DerLig
        Jour = Cells(i, "B")
        Montant = Cells(i, "I")
        Lig = i
        If Montant < 0 Then
            Do While Cells(Lig, "B") = Jour
                If Cells(Lig, "I") * -1 = Montant Then
                    Cells(Lig, "I").Interior.ColorIndex = 4
                    Cells(i, "I").Interior.ColorIndex = 6
                End If
                Lig = Lig + 1
            Loop
        End If
    Next i
End Sub

Cdlt