Suprimer les lignes

Résolu
nonossov Messages postés 638 Statut Membre -  
Frenchie83 Messages postés 2254 Statut Membre -
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

  1.
    Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. nonossov Messages postés 638 Statut Membre
       
      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
  2. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. nonossov Messages postés 638 Statut Membre
       
      Bnj, Oui je utilise la colonne D. Merci de changer le parametre du macro


      Merci infiniment
      0
  3. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
  4. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. nonossov Messages postés 638 Statut Membre
       
      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

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

    Posez votre question
  6. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. nonossov Messages postés 638 Statut Membre
       
      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
  7. Frenchie83 Messages postés 2254 Statut Membre 339
     
    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
    1. nonossov Messages postés 638 Statut Membre
       
      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

Excel : afficher toutes les lignes et colonnes masquées
livlarsen -
Mehdiiii -

27 réponses
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
Filtre excel qui ne tient pas compte des dernières lignes
claire5344 -
Claire5344 -

6 réponses