Sujet Précédent Sujet Suivant

Suprimer les lignes

Résolu/Fermé
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020 - 22 avril 2019 à 18:21
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 - 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

6 réponses

Réponse 1 / 6
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
28 avril 2019 à 18:44
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
2
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
2 mai 2019 à 10:39
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
0
Réponse 2 / 6
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
2 mai 2019 à 12:23
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
1
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
6 mai 2019 à 18:42
Bnj, Oui je utilise la colonne D. Merci de changer le parametre du macro


Merci infiniment
0
Réponse 3 / 6
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
9 mai 2019 à 12:17
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
1
Réponse 4 / 6
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
27 avril 2019 à 06:13
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
0
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
27 avril 2019 à 10:39
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
7 mai 2019 à 05:44
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
0
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
7 mai 2019 à 16:42
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
0
Réponse 6 / 6
Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
8 mai 2019 à 04:28
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
0
nonossov Messages postés 610 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
8 mai 2019 à 13:52
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
0

Discussions similaires

remettre toutes les colonnes et les lignes masquées
mousaillon -
oumnas -

4 réponses
Probleme d'affichage de ligne dans Excel
sammy79 -
Pierre65 -

12 réponses
Impossible d'afficher ou de masquer lignes et colonne excel 2007
Marzhine -
Marzhine -

7 réponses
re-afficher des colonnes masquées
paulselvan -
tsitsou -

4 réponses
Excel ne filtre pas les derniere donnée ecrite
tifou33 -
Alain -

12 réponses