XL 2016 Supprimer les montant ( + - ) en double

[ninos06]

Salut
vraiment je voudrais votre aide à mon problème
j'ai un fichier Excel qui dépasse 580.000 lignes

et je voudrais bien supprimer les montant en double et les dossier = 0

j'explique

1- supprimer les dossiers qui ont un total Zéro
2- supprimer les montant ( + - ) en double et qui ont le même numéro du dossier

Merci d'avance pour votre aide.

 

[djidji59430]

Bonjour à tous,

Avec une colonne intermédiaire, puis tu tries les 1

 

[Robert]

Bonjour le fil, bonjour le forum,

Un proposition VBA avec le code ci-dessous :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim PAS As Range 'déclare la variable PAS (Plage À Supprimer)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Worksheets("Sheet2") 'définit l'onglet O
Set PAS = O.Range("A1") 'initialise la plage à supprimer PAS
TV = O.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les liges I du tableau des valeurs TV (en partant de la seconde)
    For J = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les liges J du tableau des valeurs TV (en partant de la seconde)
        'condition : si I est différente de J et si la donnée en colonne 11 de I est la même (Dossier) que la donnée en colonne 11 de J et si la donnée en colonne 14 de I (Mvts) est l'opposé de la donnée en colonne 14 de J
        If I <> J And TV(I, 11) = TV(J, 11) And TV(I, 14) = -TV(J, 14) Then
            K = K + 2 'incrémente K
            ReDim Preserve TL(1 To K) 'redimensionne le tableau des lignes TL (K lignes)
            TL(K - 1) = I 'récupère la ligne I dans la ligne K - 1 de TL
            TL(K) = J 'récupère la ligne J dans la ligne K de TL
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
For I = 1 To UBound(TL) 'boucle sur toutes données du tableau des lignes TL
    'définit les lignes à effacer PAS (la ligne TL(I) si PAS ne contient qu'une seule celllue sinon union de toutes les ligne de TL)
    Set PAS = IIf(PAS.Cells.Count = 1, O.Rows(TL(I)), Application.Union(PAS, O.Rows(TL(I))))
Next I ' prochaine donnée de TL
PAS.Delete 'supprime la plage a supprimer PAS
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Traitement effectué !" 'message
End Sub

 

[sylvanu]

Bonjour Ninos, Djidji, Robert,
Un essai en PJ avec :

Sub Supprimer()
' Formule utilisée : =SI(OU(I2=0;ET(NB.SI(L:L;L2);NB.SI.ENS(L:L;-L2)));1;"")
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    .Range("M:M").UnMerge                       ' suppression des cellules fusionnées en colonne M
    .Columns(2).EntireColumn.Insert             'insère une colonne auxiliaire
    With .Columns(2)
        .FormulaR1C1 = _
        "=IF(OR(RC[7]=0,AND(COUNTIF(C[10],RC[10]),COUNTIFS(C[10],-RC[10]))),1,"""")"
        .Value = .Value                         'supprime les formules
        .EntireRow.Sort .Cells, xlDescending    'tri pour regrouper et accélérer
        On Error Resume Next                    'si aucune SpecialCell
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
        .EntireColumn.Delete                    'supprime la colonne auxiliaire
    End With
End With
With ActiveSheet.UsedRange: End With            'actualise les barres de défilement
End Sub

Le fait de mixer VBA et XL permet d'être extrêmement rapide.

 

[ninos06]

Bonjour le fil, bonjour le forum,

Un proposition VBA avec le code ci-dessous :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim PAS As Range 'déclare la variable PAS (Plage À Supprimer)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Worksheets("Sheet2") 'définit l'onglet O
Set PAS = O.Range("A1") 'initialise la plage à supprimer PAS
TV = O.Range("A1").CurrentRegion 'définit la tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les liges I du tableau des valeurs TV (en partant de la seconde)
    For J = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les liges J du tableau des valeurs TV (en partant de la seconde)
        'condition : si I est différente de J et si la donnée en colonne 11 de I est la même (Dossier) que la donnée en colonne 11 de J et si la donnée en colonne 14 de I (Mvts) est l'opposé de la donnée en colonne 14 de J
        If I <> J And TV(I, 11) = TV(J, 11) And TV(I, 14) = -TV(J, 14) Then
            K = K + 2 'incrémente K
            ReDim Preserve TL(1 To K) 'redimensionne le tableau des lignes TL (K lignes)
            TL(K - 1) = I 'récupère la ligne I dans la ligne K - 1 de TL
            TL(K) = J 'récupère la ligne J dans la ligne K de TL
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
For I = 1 To UBound(TL) 'boucle sur toutes données du tableau des lignes TL
    'définit les lignes à effacer PAS (la ligne TL(I) si PAS ne contient qu'une seule celllue sinon union de toutes les ligne de TL)
    Set PAS = IIf(PAS.Cells.Count = 1, O.Rows(TL(I)), Application.Union(PAS, O.Rows(TL(I))))
Next I ' prochaine donnée de TL
PAS.Delete 'supprime la plage a supprimer PAS
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Traitement effectué !" 'message
End Sub

 

[ninos06]

Merci Mr Robert
j'ai appliqué votre VB sur mon fichier qui contient presque 61.985 lignes
s'apprend un peut de temps à l’exécution du VB
mais finalement il donne les résultats demandes
reste un petit problème le VB n'a pas supprimes tous les dossiers qui ont un total 0
et donne un total général erroné
je voudrais bien vous envoyer le gros fichier mis j'ai pas pu le rejoindre parceque il est trop GROS

Je vous serais très reconnaissant si vous pouviez m'aider à établir cette solution

 

[Robert]

Bonjour le fil, bonjour le forum,

J'avoue être surpris par ta réponse. Nous sommes 3 à avoir planché sur ton travail et les autres sont devenus carrément invisibles. Ce n'est pas sympa !...
Je reviendrai quand tu auras testé et commenté les réponses de DjiDji et de Sylvanu que je salue au passage...

 

[ninos06]

Salut Mr Robert
j'ai testé votre VB s'apprend un peut de temps
à la fin il donne des résultats erronées
le total initial de 70.063,79 il à changé
à 564.625,98 en (-), et normalement il reste le même
et sur 66.253 lignes le vb à supprimer 65.666
je pense qu'il ya un problème dans le vb

merci pour votre attention
et j’attends tjr votre soutien

je m'exprime 2 fois ce que je voulait

1- supprimer les dossiers qui font un total Zéro
2- supprimer les montant ( + - ) en double et qui ont le même numéro du dossier

 

[sylvanu]

Bonsoir,
Avez vous testé la PJ du post 4 ?