VBA suppression à plusieurs condition

Version imprimable

Bonsoir tout le monde,
j'ai une VBA qui effectue le travail demander mais pour un " grand " tableau de donnée il bug et le temps d’exécution dépasse la normale.
Je pense avoir trouver le problème mais tout d'abord je vous explique ce que la macro fait :
sur une feuille 1 : il y a un tableau de chiffre ( chaque lignes à 5 colonnes )
sur une feuille 2 : il y a les consignes, des suites de chiffre à 3 colonnes et s'il apparaisse dans la feuille 1 alors il supprime la ligne de la feuille 1
le problème viendrais du fait que certaine lignes de la feuille 1 ne contienne pas les suites de chiffre de la feuille 2, au lieu de passer directement à la prochaine ligne de la feuille 1 il bug et met du temps à passer la ligne suivante.
Si quelqu'un aurait une idée de ce que je pourrais rajouter à la macro pour facilité le passage merci !
Voici ma macro :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 Dim i As Integer, j As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayStatusBar = False Application.EnableEvents = False With Sheets("Feuil2") For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row For j = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("A" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("B" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("C" & i)) > 0 Then Rows(j).EntireRow.Delete End If Next j Next i End With Application.ScreenUpdating = True Application.Calculation = xlCalculationManual Application.DisplayStatusBar = True Application.EnableEvents = True End Sub
Bonne journée à tous !

Bonjour Chloé, bonjour le forum,

Comme il manque la première ligne de ton code on ne sait pas si il se trouve dans une événementielle (Change, SelectionChange, etc.) ou dans une procédure standard (Macro1, etc.). Ce n'est pas le plus important mais je préfèrerais savoir pour la suite...

[Édition]
Essaie comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Macro2()
Dim O1 As Worksheet
Dim O2 As Worksheet
Dim TV1 As Variant
Dim TV2 As Variant
Dim I As Integer
Dim J As Integer
Dim PL As Range
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set O1 = Worksheets("Feuil1")
TV1 = O1.Range("A1").CurrentRegion
Set O2 = Worksheets("Feuil2")
TV2 = O2.Range("A1").CurrentRegion
For J = 1 To UBound(TV2, 1)
    For I = UBound(TV1, 1) To 2 Step -1
        Set PL = O1.Cells(I, "A").Resize(1, 5)
        If Application.WorksheetFunction.CountIf(PL, TV2(J, 1)) > 0 And Application.WorksheetFunction.CountIf(PL, TV2(J, 3)) > 0 Then
            O1.Rows(I).Delete
            Exit For
        End If
    Next I
Next J
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub

01/04/2020, 11h14
chloe74

bonjour,
le début c'est Sub sup1,
j'ai testé votre macro mais ma feuille 1 dépasse la fonction integer j'ai mis long à la place, et à cause du Exit for je devait faire clic par clic pour supprimer tout les lignes à supprimer,
en changeant c'est deux chose il me dit tableau attendu en surlignant le ubound.
merci pour votre aide
01/04/2020, 11h40
Thautheme

Re,

Le message est sur quelle ligne ? Ou commencent les tableaux, dans Feuil1 => A1, dans Feuil2 =A1. C'est ça ?
01/04/2020, 13h27
chloe74

Dans la feuille 1 il commence A2 et dans la feuille 2 à A1.
la feuille 1 va de A2 à E2 et la feuille 2 de A1 à C1.
mais je pense qu'il faudrait juste ajouter une ligne pour lui dire que si les conditions ne sont pas vérifier alors passer à la ligne suivante de la feuille 1
merci pour ton aide :)

Re,

le code modifié mais sans le fichier je ne peux par garantir le bon fonctionnement...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Macro1()
Dim O1 As Worksheet
Dim O2 As Worksheet
Dim TV1 As Variant
Dim TV2 As Variant
Dim I As Integer
Dim J As Integer
Dim PL As Range
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set O1 = Worksheets("Feuil1")
TV1 = O1.Range("A2").CurrentRegion
Set O2 = Worksheets("Feuil2")
TV2 = O2.Range("A1").CurrentRegion
For J = 1 To UBound(TV2, 1)
    For I = UBound(TV1, 1) To 2 Step -1
        Set PL = O1.Cells(I + 1, "A").Resize(1, 5)
        If Application.WorksheetFunction.CountIf(PL, TV2(J, 1)) > 0 And Application.WorksheetFunction.CountIf(PL, TV2(J, 3)) > 0 Then
            O1.Rows(I).Delete
            Exit For
        End If
    Next I
Next J
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub

01/04/2020, 22h13
chloe74

Je l'ai testée, elle fonctionne mais le temps est encore long, plus de 1h30 pour traiter 100 000 lignes,
peut être que le problème vient du fait que les consignes sont sur une autre feuille ?
Que puis-je rajouter pour que le contenue de la feuille 2 ( les consignes ) soit dans la feuille 1 à la ligne 170 000 par exemple ?
si tu as une idée mercii à plus
02/04/2020, 00h46
Thautheme

Re,

Arf ! 1 heure et demi de pause, c'est pas mal...:mouarf:

Franchement je pensais qu'en utilisant des variables tableau ça irait plus vide que ton code. Mais encore une fois sans fichier je ne saisis pas bien ce que tu veux que le code fasse. Je sais que c'est contraire à l'éthique de ce forum mais ne pourrais-tu pas déposer un petit fichier exemple avec juste une centaine de lignes... Aïe je me faire jeter, on m'aime pas ça ici... Mais je n'ai pas les compétences des Maîtres des ces lieux et il me faut voir. Pardonnez-moi...

désole je ne peux pas vous transmettre les données.
j'ai dans la feuille 1 : des chiffres dans 5 colonnes de colonne A à E
la feuille 2 : des chiffres dans 3 colonnes de colonne A à C
la macro ci-dessous permet de supprimer les lignes qui contiennent les différentes suites de la feuille 2 :
exemple :

COL A COL B COL C COL D COL E

1 2 3 4 10

4 3 2 1 11

1 2 6 7 14

COL A COL B COL C

1 2 3

Donc ici la première et la deuxième lignes seront supprimer car de colonnes A à E il y a 3 colonnes qui contiennes les donnée de la feuille 2.
cette macro fonctionne mais beaucoup trop lentement
La feuille 1 contient jusqu’à 500 000 ligne et la feuille 2 jusqu’à 3 000.
Si tu aurais une idée pour accélérée l’exécution :)
merci
voici la macro :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 Dim i As Integer, j As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayStatusBar = False Application.EnableEvents = False With Sheets("Feuil2") For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row For j = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1 If WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("A" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("B" & i)) > 0 And WorksheetFunction.CountIf(Range("A" & j & ":E" & j), .Range("C" & i)) > 0 Then Rows(j).EntireRow.Delete End If Next j Next i End With Application.ScreenUpdating = True Application.Calculation = xlCalculationManual Application.DisplayStatusBar = True Application.EnableEvents = True End Sub

08/04/2020, 01h23
Alex020181

Bonjour,

Thautheme a raison. Je pense qu'une piste serait l'utilisation de tableaux.
- tablo1 2 dimensions pour enregistrer la feuille1
- tablo2 2 dimensions pour enregistrer la feuille2
- tablo3 2 dimensions pour enregistrer les données de tablo1 non trouvées dans tablo2

Ensuite boucler sur toutes les lignes tablo1 et pour chacune rechercher dans tablo2.

Si les données de tablo1 ne sont pas trouvées dans tablo2 alors ne pas supprimer la ligne (supprimer une ligne prend du temps) mais l'enregistrer dans tablo3.

Ensuite reporter tablo3 soit dans une nouvelle feuille pour garder les 2 tableaux initiaux soit en effaçant les données de la feuille 1 et y insérer le tablo3 (en fait du coup vous ne supprimez pas réellement les lignes Excel mais vous reportez un tableau résultat des comparaisons).
08/04/2020, 11h51
chloe74

1 pièce(s) jointe(s)

bonjour,
je crois qu'il y a quand même un problème dans la macro de Thautheme,
voici ma fiche excel
a+

Pièce jointe 554100
08/04/2020, 16h17
Alex020181

J'ai créé un fichier avec 500 000 lignes en feuille1 et 3 000 lignes en feuille2.

Le traitement dure 2h20. C'est long. Au pro rata on reste en deça des 100 000 lignes en 1h30 mais quand même.
08/04/2020, 16h20
mfoxy

Bonjour,

Je suis sur mobile donc juste une idée

Tu pourrais peut-être ajouter un colonne sup retournant en fonction de ton code countif de ta macro, un vrai ou faux.

Ensuite filtre sur les faux, ne correspondant pas à tes critères.

Delete de ttes les lignes filtrées

Peut-être cette méthode sera plus rapide ?
08/04/2020, 16h22
chloe74

je n'ai pas compris votre message
08/04/2020, 16h39
mfoxy

Re,

Dans ta macro, tu utilises plusieurs countif imbriqué,
si retourne 1 tu supprimés ta ligne, et ainsi de suite.

Admettons que tu ajoutés un colonne dans ton tableau ou tu mettrais cette formule, étirée sur l'ensemble de ton tableau.

Ensuite filtre sur tout les résultats = 1
Et supprime toutes les lignes filtrées

Permet de se passer d'une boucle sur plus de 100000 cellule, devait donc être plus rapide, selon moi.

Je ne saurais pas te fournir un code de suite pour tester car je suis sur mon smartphone, mise à jour de pc et back up en cours
08/04/2020, 19h12
chloe74

désoler je n'ai vraiment pas compris comment je dois faire :s je dois rajouter une colonne en " D " il y aurais la valeur "1" puis je l'étire sur tout le tableau mais après je n'ai pas compris en quoi cela améliorerais :/
08/04/2020, 20h43
Alex020181

1 pièce(s) jointe(s)

Essayez ce code (voir PJ).

Insérez 500 000 lignes en feuille1 et 3 000 en feuille2. Le code retrouve seul le nombre de lignes renseignées. Le résultat de la comparaison va en feuille3 (je mets le résultat volontairement dans une autre feuille pour ne pas que vos données test de la feuille1 soient effacées le temps de votre validation).

Si cela vous convient je modifierai le code pour que le résultat aille en feuille1 comme demandé.
08/04/2020, 21h04
chloe74

le temps d’exécution est toujours long,
sinon j'ai penser a une autre chose peut être plus efficace,
si condition valider alors ne rien faire mais Si condition Non valider alors copier dans feuille 3.
comme sa au lieu de supprimer 80 000 lignes il en copiera 15 000 environ dans une feuille ?
08/04/2020, 21h12
Alex020181

Citation:

Envoyé par chloe74

le temps d’exécution est toujours long

Vu le nombre de lignes ce ne sera jamais instantané :roll:

Déjà dites nous combien de temps prend ce code et combien de temps prenait votre code d'origine.

Citation:

Envoyé par chloe74

si condition valider alors ne rien faire mais Si condition Non valider alors copier dans feuille 3.

Mon code met en feuille3 les données ne reprenant pas les 3 chiffres de la feuille2. Dois je inverser la condition ?
08/04/2020, 22h00
chloe74

je me suis tromper de macro haha non c'est bon c'est parfait ! il s'est exécuter en 16 min, c'est pile se que je voulais vraiment merci :)
bonne soirée
08/04/2020, 23h11
Alex020181
Citation:

Envoyé par chloe74

je me suis tromper de macro haha non c'est bon c'est parfait ! il s'est exécuter en 16 min, c'est pile se que je voulais vraiment merci :)
bonne soirée

Super.

Si le tableau final vous convient alors vous pouvez le rebasculer sur la feuille1 en modifiant les 3 lignes
Code:

1 2 3 4 5 6 Sheets("Feuil3").Cells.Clear Sheets("Feuil3").Range("A1:E1").Value = Sheets("Feuil1").Range("A1:E1").Value Sheets("Feuil3").Range("A2:E" & index1_tablo_feuille1 + 1) = tablo_resultat()
en
Code:

1 2 3 4 5 6 'Sheets("Feuil3").Cells.Clear 'Sheets("Feuil3").Range("A1:E1").Value = Sheets("Feuil1").Range("A1:E1").Value Sheets("Feuil1").Range("A2:E" & index1_tablo_feuille1 + 1) = tablo_resultat()
Et n'oubliez pas de cliquez sur le pouce en dessous du message précédent pour valider la réponse.