Accélérer programmation VBA

[Colombine]

Bonjour à tous,

j'ai un petit problème de vitesse d'éxécution sur une de mes programmations. J'aimerais que ce programme soit plus rapide, je n'ai peut être pas été judicieuse dans ma programmation, pouvez vous m'aider?

Résumé de ce que je veux :
Feuille 1 : ma colonne D contient des enregistrements ( exemple :T1, T2,T3,T4)
Feuille 2 : pour chaque ligne de ma feuille, si ma colonne B ne contient ni T1, ni T2 , ni T3 , ni T4 , je supprime la ligne.

Voici le programme que j'ai fait :

Sub macro1()

Dim i, nblign As Integer
Dim var1, var2, var3, var4 As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Feuill1").Select

If Cells(3, 4) <> "" Then var1 = Cells(3, 4)
If Cells(4, 4) <> "" Then var2 = Cells(4, 4)
If Cells(5, 4) <> "" Then var3 = Cells(5, 4)
If Cells(6, 4) <> "" Then var4 = Cells(6, 4)

Sheets("Feuill2").Select
nblign = ActiveSheet.UsedRange.Rows.Count
i = nblign
For i = nblign To 2 Step -1
Cells(i, 2).Select
If Selection <> var1 And Selection <> var2 And Selection <> var3 And Selection <> var4 Then
Rows(i).Delete
End If
Next i

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Voilà, si quelqu'un à une petite idée, je suis preneuse.
Merci à tous par avance

 

[Pierrot93]

Re : Accélérer programmation VBA

Bonjour Colombine,

les "select" sont rarement utiles en vba, tu pourrais commencer par modifier ce qui suit :

With Sheets("Feuill2")
nblign = .UsedRange.Rows.Count
For i = nblign To 2 Step -1
If .Cells(i, 2) <> var1 And .Cells(i, 2) <> var2 And  .Cells(i, 2) <> var3 And .Cells(i, 2) <> var4 Then Rows(i).Delete
Next i
End With

A voir ensuite si tu as des procédure événementielles dans ton classeur...

bon après midi
@+

 

[VDAVID]

Re : Accélérer programmation VBA

Bonjour Colombine, Pierrot93,

Dans un module de ton classeur, précédé de la mention Option Base 1:

Sub Accélération()

Dim tabl(), tabl1()
Dim Ws As Worksheet
Dim maplage As Range
Dim i As Long, k As Long, j As Long, z As Long
Dim var1, var2, var3, var4 As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual



Set Ws = Sheets("Feuil2")
    
    With Sheets("Feuil1")
    
    If .Cells(3, 4) <> "" Then var1 = .Cells(3, 4)
    If .Cells(4, 4) <> "" Then var2 = .Cells(4, 4)
    If .Cells(5, 4) <> "" Then var3 = .Cells(5, 4)
    If .Cells(6, 4) <> "" Then var4 = .Cells(6, 4)


    End With


    With Ws
    
        Set maplage = .Range(.Cells(1, 1), .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, .Cells.SpecialCells(xlCellTypeLastCell).Column))
        
        z = 2
        tabl = maplage.FormulaLocal
        ReDim tabl1(UBound(tabl(), 1), UBound(tabl(), 2))
        
            For i = LBound(tabl()) To UBound(tabl())
                
                If i <> 1 Then
                If tabl(i, 2) = var1 Or tabl(i, 2) = var2 Or tabl(i, 2) = var3 Or tabl(i, 2) = var4 Then
                    
                    For k = LBound(tabl(), 2) To UBound(tabl(), 2)
                        
                        tabl1(z, k) = tabl(i, k)
                       
                    Next k
                    z = z + 1
                    
                End If
                End If
                
            Next i
        
    End With
    maplage.FormulaLocal = tabl1

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic



End Sub

Bonne journée !

 

[Dranreb]

Re : Accélérer programmation VBA

Bonjour
Il y a plus simple et rapide à faire à mon avis.
Utiliser une colonne libre pour y mettre une Formule avec EQUIV
Supprimer les lignes entières des cellules de cette colonne qui rendent spécialement une valeur d'erreur.

 

[Colombine]

Re : Accélérer programmation VBA

bonjour vdavid,
cette méthode est encore plus rapide mais trop radicale !! Rires

Elle me supprime toutes mes lignes même celles dont ma variable est reconnu.
je ne comprends pas toute ta programmation donc je n'arrive pas à voir ou est l'erreur.

Colombine

 

[VDAVID]

Re : Accélérer programmation VBA

Re Colombine,Pierrot93, bonjour Danreb

J'avais oublié de mettre les "." devant les deuxième "Cells" sur ces 4 lignes:

If .Cells(3, 4) <> "" Then var1 = .Cells(3, 4)
If .Cells(4, 4) <> "" Then var2 = .Cells(4, 4)
If .Cells(5, 4) <> "" Then var3 = .Cells(5, 4)
If .Cells(6, 4) <> "" Then var4 = .Cells(6, 4)

De plus, il faut bien rajouter Option Base 1 devant le code de la macro dans le module
Si ça ne marche toujours pas, un petit fichier exemple pourrait être utile

 

[Compte Supprimé 979]

Re : Accélérer programmation VBA

Bonjour le fil

Essaye ça, sur une idée de Pierrot93

Sub macro1()
  Dim i, nblign As Integer
  Dim var1, var2, var3, var4 As String


  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False


  With Sheets("Feuill1")
    If .Cells(3, 4) <> "" Then var1 = .Cells(3, 4)
    If .Cells(4, 4) <> "" Then var2 = .Cells(4, 4)
    If .Cells(5, 4) <> "" Then var3 = .Cells(5, 4)
    If .Cells(6, 4) <> "" Then var4 = .Cells(6, 4)
  End With
  With Sheets("Feuill2")
    nblign = .UsedRange.Rows.Count
    For i = nblign To 2 Step -1
      If .Cells(i, 2) <> var1 And .Cells(i, 2) <> var2 And .Cells(i, 2) <> var3 And .Cells(i, 2) <> var4 Then Rows(i).Delete
    Next i
  End With


  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

A+

 

[ChTi160]

Re : Accélérer programmation VBA

Bonjour VDAVID
Bonjour le Fil (Quel beau monde !)
Bonjour le forum

je suis parti de la proposition De Bruno.

Option Explicit
Option Base 1
Sub macro1()
  Dim i, nblign As Integer
  Dim Tablo(4) As Variant

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False

  With Sheets("Feuil1")
  For i = 3 To 6
    If .Cells(i, 4) <> "" Then Tablo(i - 2) = .Cells(i, 4)
  Next i
  End With
  With Sheets("Feuil2")
    nblign = .UsedRange.Rows.Count + 1
    For i = nblign To 2 Step -1
      If .Cells(i, 2) <> Tablo(1) And .Cells(i, 2) <> Tablo(2) And .Cells(i, 2) <> Tablo(3) And .Cells(i, 2) <> Tablo(4) Then .Rows(i).Delete xlUp
    Next i
  End With
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub

Bonne fin de journée
Amicalement
Jean marie

 

[Colombine]

Re : Accélérer programmation VBA

pour l'instant la méthode la plus rapide est celle de VdAVID par contre je ne la comprends pas.
Je dois reproduire le même programme avec ma colonne E feuille 1 et ma colonne c feuille2 mais je n'arrive pas à l'adapter car je ne comprends pas a quoi correspondent les variables i,k,j,z et les redim.
Pouvez vous m'expliquer afin que j'arrive à l'adapter?
Merci

 

[Herdet]

Re : Accélérer programmation VBA

Bonjour VDAVID
Bonjour le Fil (Quel beau monde !)
Bonjour le forum
je suis parti de la proposition De Bruno.

    For i = nblign To 2 Step -1
      If .Cells(i, 2) <> Tablo(1) And .Cells(i, 2) <> Tablo(2) And .Cells(i, 2) <> Tablo(3) And .Cells(i, 2) <> Tablo(4) Then .Rows(i).Delete xlUp
    Next i
 
Jean marie[/QUOTE]
On peut simplifier encore un peu en utilisant Match qui évite de tester une par une les lignes de Tablo :
    For i = nblign To 2 Step -1
      If IsError(Application.Match(.Cells(i, 2), Tablo, 0)) Then .Rows(i).Delete xlUp
    Next i

A+
Robert

 

[Herdet]

Re : Accélérer programmation VBA

encore un peu plus simple en remplaçant Tablo par un Set b =
Peut être un peu plus rapide.
A+ Robert

Sub Suppression_lignes()
   Dim i, nblign As Integer
   Dim b As Variant
   
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Application.EnableEvents = False
   
   Set b = Sheets("Feuil1").Range("D3:D6")

   With Sheets("Feuil2")
      For i = .UsedRange.Rows.Count + 1 To 2 Step -1
         If IsError(Application.Match(.Cells(i, 2), b, 0)) Then .Rows(i).Delete xlUp
      Next i
   End With

   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
End Sub

 

[Si...]

Re : Accélérer programmation VBA

salut

Si... tu cherches la rapidité tu peux essayer

Option Explicit
Sub EFF()
  Dim dl As Long, dc As Long
  With Feuil2
    dl = .Cells(Rows.Count, 2).End(xlUp).Row
    dc = .Cells(1, Columns.Count).End(xlToLeft).Column
    Columns(3).Insert
    .[C1].FormulaR1C1 = _
        "=(RC[-1]=Feuil1!R1C[1])+(RC[-1]=Feuil1!R2C[1])+(RC[-1]=Feuil1!R3C[1])+(RC[-1]=Feuil1!R4C[1])"
    .[C1].AutoFill Destination:=Range("C1:C" & dl), Type:=xlFillDefault
    .Range("A1").Resize(dl, dc + 1).Sort [C1], 2
    .Rows([C:C].Find(0, , xlValues).Row & ":" & dl).Delete
    Columns(3).Delete
  End With
End Sub

 

[VDAVID]

Re : Accélérer programmation VBA

Bonsoir tout le monde ! Colombine,

L'idée du code c'est qu'au lieu de manipuler des cellules on manipules des données, du coup c'est beaucoup plus rapide. En fait on crée un tableau virtuel à deux dimensions de la taille de la feuille dans laquelle on va supprimer des lignes.

Donc dans notre tableau virtuel de base 1, le premier chiffre représente le numéro de ligne, et le deuxième chiffre représente le numéro de la colonne. tabl(1,2).

Pour adapter dans ton cas, il faut remplacer cette deuxième dimension par le numéro de lanouvelle colonne c'est à dire 3 ici pour la colonne C soit:

If tabl(i, 3) = var1 Or tabl(i, 3) = var2 Or tabl(i, 3) = var3 Or tabl(i, 3) = var4 Then

Pour le reste je pense que tu peux adapter dans les .Cells(x,5) facilement, les feuilles aussi

N'hésite pas si tu n'y arrives pas !

 

[Colombine]

Re : Accélérer programmation VBA

d'abord merci pour toutes vos idées, certaines fonctionnent mais j'aimerais comprendre celle de david c'est pourquoi j'ai fait un fichier ci joint:

feuil1 : les données qui vont me servir de variable en colonne D ( et E ensuite)
feuil2 : tableau de données dans le quel je ne veux garder que les enregistrements dont la colonne B contient une des variables contenu dans mes variables feuil1 colonne D / puis les enregistrements dont la colonne C contient une des variables contenu dans mes variables feuil1 colonne E.

J'ai mis la macro de David mais j'ai des pbs:
le TB final a supprimé la ligne des titres et il n'est plus positionné en A1
Quand je lance la macro en voulant passer à l'étape suivante pour refaire opération mais sur colonne C par rapport à feuil1 colonne E, il persiste à me laisser le dernier enregistrements et plein de lignes à vide entre.

Merci à celui qui pourra me filer un coup de main car je trouve cette methodo très puissante et je pense ne pas être loin de la solution mais ..... il me faut les derniers réglages de PROS ! Rires.

Colombine

 

[Dranreb]

Re : Accélérer programmation VBA

La mienne c'est :

Sub Macro1()
With Feuil2.[G2].Resize(Feuil2.UsedRange.Rows.Count - 1)
   On Error Resume Next
   .FormulaR1C1 = "=MATCH(RC2,Feuil1!R3C4:R6C4,0)"
   .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
   .FormulaR1C1 = "=MATCH(RC3,Feuil1!R3C5:R6C5,0)"
   .SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
   .ClearContents
   End With
End Sub