XL 2013 VBA de suppression

sirine10 · 6 Avril 2020

Bonjour tout le monde,
j'ai un gros problème avec ma VBA car elle met beaucoup beaucoup trop de temps à s’exécuter. Sa fonction est :
( j'ai deux feuilles excel, la 1er contient des données de chiffres de colonne A à E; et la 2eme feuilles des donnée de chiffres de colonne A à C )
de supprimer tout les lignes de la feuille 1 qui contient les 3 chiffres des 3 colonnes de la feuille 2, puis de passer à la suivant ligne de la feuille 2.
j'ai aussi remarquer que lorsque dans la feuille 1 il n'y a pas présence des conditions de la feuille 2 alors au lieu de terminer directement l'execution car rien à supprimer elle se met à buger.
La feuille 1 contient 100 000 lignes
la feuille 2 contient 4 000 lignes
si quelqu'un aurait une solution à mon problemme je lui en serrais reconnaissant merci !
bonne journée à tous

Voici ma macro :
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

dg62 · 8 Avril 2020

copier le contenu de Feuil1 de votre classeur sur la Feuil1 de mon classeur

sirine10 · 8 Avril 2020

Le fichier est trop volumineux cela ne marche pas , 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 ?

dg62 · 8 Avril 2020

C'est dommage de ne pas essayer ma procédure.
Dernière tentative
Placez vous sur la première cellule du tableau de la feuille 2
Ctrl shift End Cela sélectionne votre base
Tableau mise en forme et validez
Votre base s'appelle tableau 1
Répéter l'opération sur la feuille 1 le tableau porte le nom tableau 2
Copier ma procédure dans un module et l'essayer.

cp4 · 8 Avril 2020

sirine10 à dit:
Le fichier est trop volumineux cela ne marche pas , 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 ?

Sur la feuille 2, il y a des lignes en doublons.
Il faudrait commencer par supprimer ces lignes.

VB:

dl2 = Sheets("feuil2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("feuil2").Range("A2:C" & dl2).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo

sirine10 · 8 Avril 2020

ahhhh mince j'ai mal compris j'ai cru que vous vouliez que je vous renvoie le document c'est pour ça jai dis que c'est impossible de joindre le fichier.
je l'ai tester mais regarder le problème il ne supprimer que si col A feuille 1 = col A feuille 2
alors que les valeurs de la feuille 2 peuvent êtres n importe. Regarder le fichier joint vous comprendrez
a+

dg62 · 9 Avril 2020

Bonsoir,
ce code semble fonctionner

VB:

Sub teste()
Dim i As Integer, j As Long
Dim ca As Integer, cb As Integer, cc As Integer
Dim T1 As Variant
Dim T2 As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
' initialisation des variables
T1 = Range("tableau1").Value 'feuil 2
T2 = Range("tableau2").Value 'feuil 1
ca = 0 ' indicateurs
cb = 0 ' de
cc = 0 ' présence


     For i = 1 To UBound(T1)
   
        For j = UBound(T2) To 1 Step -1
       
        a = T1(i, 1) ' stokage de
        b = T1(i, 2) ' la ligne
        c = T1(i, 3) ' du tableau 1 traitée
       
        For x = 1 To 5 ' parcours de la ligne traitée du tableau 2
       
         If T2(j, x) = a Then ca = 1 ' si chiffre présent ca = 1
         If T2(j, x) = b Then cb = 1 ' idem
         If T2(j, x) = c Then cc = 1 ' idem
        
        Next x
       
        If ca + cb + cc = 3 Then ' si la somme des indicateurs est = 3 alors les chiffres sont présents
            ThisWorkbook.Worksheets("feuil1").Rows(j + 1).Delete ' on peut effacer la ligne correspondante
        End If
       
        ca = 0 ' remise
        cb = 0 ' à 0
        cc = 0 ' des indicateurs
       
        Next j
           
     Next i
   

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True

End Sub

dg62 · 9 Avril 2020

Bonjour,
je viens de faire le test sur le fichier initial avec ma procédure, temps de traitement 90.66 secondes.

11 minutes avec votre procédure

dg62 · 10 Avril 2020

Bonjour le fil,

Pas de retour ?

XL 2013 VBA de suppression

sirine10

XLDnaute Nouveau

dg62

XLDnaute Barbatruc

Pièces jointes

sirine10

XLDnaute Nouveau

dg62

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

sirine10

XLDnaute Nouveau

Pièces jointes

dg62

XLDnaute Barbatruc

dg62

XLDnaute Barbatruc

dg62

XLDnaute Barbatruc

Discussions similaires