Simplifier vba - code simple trop lent

[sebastien450]

Ci-dessous un code

Range("N1") = cible
MaDate = ActiveSheet.Range("N1")
For i = [A65000].End(xlUp).Row To 1 Step -1
If Cells(i, 6) = MaDate Then Rows(i).Delete
Next i

Je compare la cellule située en N1 (une date format xx/xx/xxxx) avec les cellules colonnes "F" qui ont également des dates et supprimes si idem.

très bien,
mais malgré mes 2500 lignes de recherches il lui faut +10min pour arriver a mes fins!

Comment le simplifier?

 

[laetitia90]

Re : Simplifier vba - code simple trop lent

bonjour sebastien450

comme cela pas simple sans fichier

autrement en debut de code mettre deja

Application.ScreenUpdating = False

si beaucoup de formules deactiver calcul auto en debut de code egalement attention remettre en auto avant end sub

idem si evementielle ect..

en plus propre exemple

Sub tamacro()
 With Application
 .Calculation = xlCalculationManual: .ScreenUpdating = 0: .EnableEvents = 0
 'TON CODE
 'ect...
 .Calculation = xlCalculationAutomatic: .ScreenUpdating = 1: .EnableEvents = 1
 End With
End Sub

 

[sebastien450]

Re : Simplifier vba - code simple trop lent

Merci !
Est-ce possible de découper les zones pour que la macro ne travaille que par zone de ligne de 500 par 500 ?

Sébastien

 

[laetitia90]

Re : Simplifier vba - code simple trop lent

re
bien sur mais tu iras pas plus vite !!!!

autrement tu as des formules, evenementielles ect... combien de colonnes


c'est pour cela qu'un fichier exemple est recommande

 

[laetitia90]

Re : Simplifier vba - code simple trop lent

re

pour moi !!!meme sur un vieux pc 2500 lignes <5 secondes avec ta methode

 

[sebastien450]

Re : Simplifier vba - code simple trop lent

Disons que cela concerne 6 colonnes, et constitue une zone qui est utilisée dans un TCD + un graphe dynamique créé a partir du tcd....
comment on desactive le mode de calcul automatique en vba (et je le reactiverais aprés)

 

[sebastien450]

Re : Simplifier vba - code simple trop lent

Bon, je réponds et solde le sujet=> en supprimant le calcul automatique, je supprime mon problème.
ActiveWorkbook.RefreshAll" avant la clôture de la macro peut être utile.

 

[laetitia90]

Re : Simplifier vba - code simple trop lent

RE

j' ai mis un exemple plus haut je le remets par contre si tcd suremenent le reactualiser avant end sub

je connais pas trop cette "bête "

Sub tamacro()
 With Application
 .Calculation = xlCalculationManual: .ScreenUpdating = 0: .EnableEvents = 0
 'TON CODE
 'ect...
 .Calculation = xlCalculationAutomatic: .ScreenUpdating = 1: .EnableEvents = 1
 End With
End Sub

 

[job75]

Re : Simplifier vba - code simple trop lent

Bonjour sebastien450, Laetitia

Une solution par tableaux VBA, voyez si elle convient :

Sub SupprimerLignes()
Dim duree, cible, P As Range, dat, t, ncol%, i&, n&, j%
duree = Timer
With ActiveSheet
  cible = .[N1]
  Set P = .Range(.[A1:A2], .UsedRange) 'au moins 2 cellules
  dat = P.Columns(6) 'colonne à tester
  t = P.FormulaR1C1: ncol = UBound(t, 2)
  For i = 1 To UBound(t)
    If dat(i, 1) <> cible Then
      n = n + 1
      For j = 1 To ncol
        t(n, j) = t(i, j)
      Next j
    End If
  Next i
  If n Then P.Resize(n) = t
  .Rows(n + 1 & ":" & .Rows.Count).Delete
  With .UsedRange: End With 'actualise la barre de défilement verticale
End With
MsgBox "Durée " & Format(Timer - duree, "0.00 \s") 'mesure facultative
End Sub

A+

 

[Dranreb]

Re : Simplifier vba - code simple trop lent

Bosoir.

Il y a aussi ça qui devrait marcher pas mal :

Range("N1") = cible
LignesOùCondR1C1(Rows(1), "RC6=R1C14").Delete

Après installation de ces procédures de service :

Function ColLignesOùRelat(ByVal CelDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Rem. ——— Cellules partant de CelDéb dans sa colonne où la colonne ColQuoi est en relation Opé avec Valeur.
Set ColLignesOùRelat = Intersect(LignesOùRelat(CelDéb, ColQuoi, Opé, Valeur), CelDéb.EntireColumn)
End Function

Function LignesOùRelat(ByVal LigneDéb As Range, ByVal ColQuoi, ByVal Opé As String, ByVal Valeur) As Range
Rem. ——— Lignes entières partant de LigneDéb où la colonne ColQuoi est en relation Opé avec une Valeur.
If Not IsNumeric(ColQuoi) Then ColQuoi = LigneDéb.Worksheet.Columns(ColQuoi).Column
If VarType(Valeur) = vbString Then Valeur = """" & Replace(Valeur, _
   """", """""") & """" Else Valeur = Trim$(Str$(Valeur))
Set LignesOùRelat = LignesOùCondR1C1(LigneDéb, CondR1C1:="RC" & ColQuoi & Opé & Valeur)
End Function

Function ColLignesOùCondR1C1(ByVal CelDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Cellules partant de CélDéb dans sa colonne dont les lignes vérifient une condition R1C1 CondR1C1.
Set ColLignesOùCondR1C1 = Intersect(LignesOùCondR1C1(CelDéb, CondR1C1), CelDéb.EntireColumn)
End Function

Function LignesOùCondR1C1(ByVal LigneDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Lignes entières partant de LigneDéb qui vérifient une condition R1C1 CondR1C1.
Dim Lignes As Range, ColTrv As Range
With LigneDéb.Worksheet.UsedRange
   Set Lignes = LigneDéb.EntireRow.Resize(.Rows.Count + .Row - LigneDéb.Row)
   Set ColTrv = Intersect(.Columns(.Columns.Count + 1), Lignes): End With
ColTrv.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
On Error Resume Next
Set LignesOùCondR1C1 = ColTrv.SpecialCells(xlCellTypeFormulas, 1).EntireRow
ColTrv.Delete xlShiftToLeft
End Function