Menu

Suprimer les lignes [Résolu]

Messages postés
554
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
20 mai 2019
- - Dernière réponse : Frenchie83
Messages postés
1923
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
13 mai 2019
- 9 mai 2019 à 12:17
Bonjour mes amis

J'aimerai biens m'aider à supprimer les lignes qui se caractérise comme suite:

colone A / Colonne B/ colonne C:
01/01/19/Paris/10.00
01/01/19/Paris/-05.00
01/01/19/Paris/-05.00

dans ce cas le resultat:
01/01/19/Paris/10.00
-----
01/01/19/Paris/10.00
01/01/19/Paris/-10.00

dans ce cas le resultat:
01/01/19/Paris/10.00
----
01/01/19/Paris/-10.00
01/01/19/Paris/10.00
dans ce cas le resultat:
01/01/19/Paris/-10.00

C-a-d je veux suprimer le contre partie du premiere ligne,

Merci pour votre Aide



Configuration: Windows / Firefox 52.0
Afficher la suite 

Votre réponse

6 réponses

Meilleure réponse
Messages postés
1923
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
13 mai 2019
253
2
Merci
Bonjour,

Questions:
Je vois que sur les lignes secondaires, les horaires sont négatifs. S'agit-il réellement du signe "moins" ou bien d'un simple tiret? et est-ce toujours comme ça?

Dans votre 2ème exemple: on doit considérer - 08:00 + - 02:00 = 10:00 donc on fait abstraction du signe "moins". Mais suite à la première question, peut-on avoir 08:00 + - 02:00, dans ce cas là, doit faire l'addition et obtenir un résultat de 06:00, ou bien ignore -t-on les signes?

Si vous pouviez fournir plus de détails pour enlever toute ambiguité, le résultat pourrait en être que meilleur et surtout cela éviterait des échanges incessants.

Cdlt

Dire « Merci » 2

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 39335 internautes nous ont dit merci ce mois-ci

nonossov
Messages postés
554
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
20 mai 2019
-
Merci Mr pour votre reponse,
Ne le signe ne signifie pas moins, just un sumple signe, que mon programme d'export l'ajoute pour faire la deff entre Debit et credit de la comptabilité,

Oui. vous pouvez negliger ce signe et travailler just sur les chiffres:

-08.00 + -02.00 = 10

Nb: 08:00 n'est pas un honoraire, c'est un simple chiffres. c'est 08.00


Merci infiniment
Commenter la réponse de Frenchie83
Messages postés
1923
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
13 mai 2019
253
1
Merci
Bonjour,

Essayez ceci. Attention j'utilise provisoirement les colonnes D à F pour faire des calculs intermédiaires et qui sont effacés à la fin. Donc s'il y a des données dans ces colonnes, me le dire pour que je modifie la macro.
Sub Supp_Lignes()
    Application.ScreenUpdating = False
    DerLig = [A10000].End(xlUp).Row
   
    For i = 2 To DerLig
        If Cells(i, "A") <> Cells(i - 1, "A") Or Cells(i, "B") <> Cells(i - 1, "B") Then
            Cells(i, "D") = 1
        Else
            Cells(i, "D") = Cells(i - 1, "D") + 1
        End If
    Next i
    Range("E2:E" & DerLig).FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(RC[-2],""-"","""",1),""."","","",1)"
    Range("F2:F" & DerLig).FormulaR1C1 = "=IF(R[1]C[-2]="""",RC[-1],IF(AND(RC[-2]>1,R[1]C[-2]>1),R[1]C+RC[-1],IF(AND(RC[-2]=1,R[1]C[-2]>1),RC[-1]-R[1]C,RC[-1])))"
    Range("E2:F" & DerLig).Value = Range("E2:F" & DerLig).Value
    
    Lig = 2
Boucle:
    If Cells(Lig, "A") = "" Then
        Columns("D:F").ClearContents
        Exit Sub
    End If
    If Cells(Lig, "D") = 1 And Cells(Lig, "F") = 0 And Cells(Lig + 1, "D") > 1 Then
        Rows(Lig + 1).EntireRow.Delete
        GoTo Boucle
    Else
        Lig = Lig + 1
        GoTo Boucle
    End If
End Sub


Cdlt
nonossov
Messages postés
554
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
20 mai 2019
-
Bnj, Oui je utilise la colonne D. Merci de changer le parametre du macro


Merci infiniment
Commenter la réponse de Frenchie83
Messages postés
1923
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
13 mai 2019
253
1
Merci
Bonjour,

Voici la dernière mouture,
Sub Supp_Lignes()
    Dim DerLig As Long, i As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    DerLig = [A10000].End(xlUp).Row
    Range("K2:K" & DerLig).FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(RC[-8],""-"","""",1),""."","","",1)"
    
'1ère passe, on supprime les doublons *************************************************************************************

    For i = 2 To DerLig
        If Cells(i, "A") <> Cells(i - 1, "A") Or Cells(i, "B") <> Cells(i - 1, "B") Then
            Cells(i, "J") = 1
        Else
            If Cells(i, "K") = Cells(i - 1, "K") Then
                Cells(i, "J") = Cells(i - 1, "J") + 1
            Else
                Cells(i, "J") = 1
            End If
        End If
    Next i
    Range("L2:L" & DerLig).FormulaR1C1 = "=IF(R[1]C[-2]="""",RC[-1],IF(AND(RC[-2]>1,R[1]C[-2]>1),R[1]C+RC[-1],IF(AND(RC[-2]=1,R[1]C[-2]>1),RC[-1]-R[1]C,RC[-1])))"
    Range("J2:L" & DerLig).Value = Range("J2:L" & DerLig).Value
    
    ActiveSheet.AutoFilterMode = False
    Range("A1:L1").Select
    If ActiveSheet.AutoFilterMode Then
        isOn = "On"
    Else
        isOn = "Off"
        Selection.AutoFilter
    End If
    Range("A2:L" & DerLig).AutoFilter Field:=10, Criteria1:="2"
    
    Range("A2:L" & DerLig).SpecialCells(xlCellTypeVisible).Delete
    ActiveSheet.AutoFilterMode = False
    
'2ème passe, on supprime les sommes formant une égalité avec la première ligne avec date et libellé identiques******************
    DerLig = [A10000].End(xlUp).Row
    For i = 2 To DerLig
        If Cells(i, "A") <> Cells(i - 1, "A") Or Cells(i, "B") <> Cells(i - 1, "B") Then
            Cells(i, "J") = 1
        ElseIf Cells(i, "A") = Cells(i - 1, "A") And Cells(i, "B") = Cells(i - 1, "B") Then Cells(i, "J") = Cells(i - 1, "J") + 1
        End If
    Next i
    
    For i = DerLig To 4 Step -1
        If Cells(i, "J") = 3 Then
            If Cells(i, "L") * 1 + Cells(i - 1, "L") * 1 = Cells(i - 2, "L") * 1 Then Range("A" & i - 1 & ":L" & i).EntireRow.Delete
        End If
    Next i
    Columns("J:L").ClearContents
    MsgBox "Opération terminée, cliquez sur le bouton bleu puis sur le bouton orange pour recommencer le test"
End Sub


Avec le fichier
https://mon-partage.fr/f/7r9WoILe/

Cdlt
Commenter la réponse de Frenchie83
Messages postés
1923
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
13 mai 2019
253
0
Merci
Bonjour,

Si j'ai bien compris, à date et ville identiques sur plusieurs lignes, on ne garde que la première ligne.
Sub Supp_Lignes()
    Application.ScreenUpdating = False
    DerLig = [A10000].End(xlUp).Row
    For i = DerLig - 1 To 2 Step -1
        If Cells(i, "A") = Cells(i + 1, "A") And Cells(i, "B") = Cells(i + 1, "B") Then Rows(i + 1).Delete
    Next i
End Sub


Cdlt
nonossov
Messages postés
554
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
20 mai 2019
-
Non, il faut ajouter une 3eme creteres, c'est le montant de la ligne s'il se repete en suprimme le deuxieme, comme ça:
1/01/19/Paris/10.00
01/01/19/Paris/-10.00

dans ce cas le resultat:
01/01/19/Paris/10.00

et si la somme de 3eme ligne et 2eme ligne donne la valeur de premiere ligne en supprime la 3eme et 2 eme ligne comme ça:

colone A / Colonne B/ colonne C:
01/01/19/Paris/10.00
01/01/19/Paris/-08.00
01/01/19/Paris/-02.00

dans ce cas le resultat:
01/01/19/Paris/10.00
la macro va repeter cette tache sur les autres lignes

Merci
Commenter la réponse de Frenchie83
Messages postés
1923
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
13 mai 2019
253
0
Merci
Bonjour,

Voilà avec utilisation des colonnes J,K,L à la place de D,E,F
Sub Supp_Lignes()
    Application.ScreenUpdating = False
    DerLig = [A10000].End(xlUp).Row
   
    For i = 2 To DerLig
        If Cells(i, "A") <> Cells(i - 1, "A") Or Cells(i, "B") <> Cells(i - 1, "B") Then
            Cells(i, "J") = 1
        Else
            Cells(i, "J") = Cells(i - 1, "J") + 1
        End If
    Next i
    Range("K2:K" & DerLig).FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(RC[-8],""-"","""",1),""."","","",1)"
    Range("L2:L" & DerLig).FormulaR1C1 = "=IF(R[1]C[-2]="""",RC[-1],IF(AND(RC[-2]>1,R[1]C[-2]>1),R[1]C+RC[-1],IF(AND(RC[-2]=1,R[1]C[-2]>1),RC[-1]-R[1]C,RC[-1])))"
    Range("J2:K" & DerLig).Value = Range("E2:F" & DerLig).Value
    
    Lig = 2
Boucle:
    If Cells(Lig, "A") = "" Then
        Columns("J:L").ClearContents
        Exit Sub
    End If
    If Cells(Lig, "J") = 1 And Cells(Lig, "F") = 0 And Cells(Lig + 1, "J") > 1 Then
        Rows(Lig + 1).EntireRow.Delete
        GoTo Boucle
    Else
        Lig = Lig + 1
        GoTo Boucle
    End If
End Sub


Cdlt
nonossov
Messages postés
554
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
20 mai 2019
-
je ne sais pas pourquoi la macro ne marche pas pas,

Merci d'essayer de l'executer sur ce fichier

https://www.cjoint.com/c/IEhoQpz4q1z

Merci
Commenter la réponse de Frenchie83
Messages postés
1923
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
13 mai 2019
253
0
Merci
Bonjour,

Un petit oubli de ma part dans la modification
Range("J2:K" & DerLig).Value = Range("J2:K" & DerLig).Value
à la place de
Range("J2:K" & DerLig).Value = Range("E2:F" & DerLig).Value


Sub Supp_Lignes()
    Application.ScreenUpdating = False
    DerLig = [A10000].End(xlUp).Row
   
    For i = 2 To DerLig
        If Cells(i, "A") <> Cells(i - 1, "A") Or Cells(i, "B") <> Cells(i - 1, "B") Then
            Cells(i, "J") = 1
        Else
            Cells(i, "J") = Cells(i - 1, "J") + 1
        End If
    Next i
    Range("K2:K" & DerLig).FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(RC[-8],""-"","""",1),""."","","",1)"
    Range("L2:L" & DerLig).FormulaR1C1 = "=IF(R[1]C[-2]="""",RC[-1],IF(AND(RC[-2]>1,R[1]C[-2]>1),R[1]C+RC[-1],IF(AND(RC[-2]=1,R[1]C[-2]>1),RC[-1]-R[1]C,RC[-1])))"
    Range("J2:K" & DerLig).Value = Range("J2:K" & DerLig).Value
    
    Lig = 2
Boucle:
    If Cells(Lig, "A") = "" Then
        Columns("J:L").ClearContents
        Exit Sub
    End If
    If Cells(Lig, "J") = 1 And Cells(Lig, "F") = 0 And Cells(Lig + 1, "J") > 1 Then
        Rows(Lig + 1).EntireRow.delete
        GoTo Boucle
    Else
        Lig = Lig + 1
        GoTo Boucle
    End If
End Sub


Cdlt
nonossov
Messages postés
554
Date d'inscription
lundi 29 décembre 2014
Statut
Membre
Dernière intervention
20 mai 2019
-
Bnjr,

La macro supprime toutes les lignes qui ont même libelle c.-à-d. qui ont le même nom de colonne B, il faut se baser juste sur colonne A la date, et le montant colonne C,

Exemple si j’ai ça :

01/07/2018 HONGOMAS 128192 Visualisez

01/07/2018 HONGOMAS -128192 Visualisez

01/07/2018 ORANGE 282,03 Visualisez

01/07/2018 ORANGE -282,03 Visualisez

01/07/2018 ORANGE 660 Visualisez

01/07/2018 ORANGE -660 Visualisez

01/07/2018 ORANGE 449,51 Visualisez

01/07/2018 ORANGE -449,51 Visualisez

01/07/2018 ORANGE 333,34 Visualisez

01/07/2018 ORANGE -333,34 Visualisez

01/07/2018 ORANGE 207,5 Visualisez

01/07/2018 ORANGE -207,5 Visualisez

01/07/2018 ORANGE 333,33 Visualisez

01/07/2018 ORANGE -333,33 Visualisez


Le résultat :

01/07/2018 HONGOMAS 128192 Visualisez

01/07/2018 ORANGE 282,03 Visualisez

01/07/2018 ORANGE 660 Visualisez

01/07/2018 ORANGE 449,51 Visualisez

01/07/2018 ORANGE 333,34 Visualisez

01/07/2018 ORANGE 207,5 Visualisez

01/07/2018 ORANGE 333,33 Visualisez


Merci infiniment
Commenter la réponse de Frenchie83