XL 2013 aide pour optimisation du code vba RESOLU

[maspi69]

bonjour,

J'ai un tableau assez volumineux.

dans une procédure je dois effacer les lignes dont les cellules sont = 0

pour cela j'ai écris :

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

For i = dernierelignejlvt To 2 Step -1
If Cells(i, 43) = 0 Then
Rows(i).EntireRow.Delete
End If
Next i

C'est beaucoup trop long ( 15 mn sur un I7 4700HQ ...).

Quelqu’un peut-il m'aider ?

Un grand merci d'avance

 

[Lone-wolf]

Re : aide pour optimisation du code vba

Bonsoir maspi,

peut-être en filtrant d'abord les cellules et ensuite

Cells.SpecialCells(xlTypeVisible).Delete



A+

 

[Lone-wolf]

Re : aide pour optimisation du code vba

Re,

colonne à adapter.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("a1:z65536").AutoFilter Field:=43, Criteria1:="=0", Operator:=xlAnd

On Error Resume Next
lig = Cells(Rows.Count, 43).End(xlUp).Row
        For i = lig To 2 Step -1
            If Cells(i, 43) = 0 Then Rows(i).Delete
        Next
                Range("a1:z65536").AutoFilter
End Sub

A+

 

[cathodique]

Re : aide pour optimisation du code vba

Bonsoir,

Ton tableau a combien de colonnes?
j'ai considéré qu'il avait 43 colonnes. Essais ce code sur une copie de ton fichier.

Sub supprimer_ligne()
Dim LastLig As Long
        Dim Plage As Range
        Application.ScreenUpdating = False
        With ActiveSheet  'feuille à adapter
           LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
           Set Plage = .Range("A1:AQ" & LastLig)
           Plage.AutoFilter Field:=43, Criteria1:=0
           If Plage.SpecialCells(xlCellTypeVisible).Count > Plage.Columns.Count Then
              .Range("A2:AQ" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
           End If
           Plage.AutoFilter
           Set Plage = Nothing
        End With
End Sub

Sans fichier pas facile de tester. Mais c'est plus rapide que de boucler sur toutes les lignes. Là on supprimer les lignes filtrées comme te l'avais suggéré Lone-wolf (que je salue ).

 

[laetitia90]

Re : aide pour optimisation du code vba

bonsoir tous
si la chronologie pas importante on pourrait mettre les lignes avec 0 en fin de tableau

code basique a adapter

 Dim c, x As Long
  [a2:aq60000].Sort Key1:=[aq2], Order1:=xlDescending, Header:=xlGuess
  Set c = [aq:aq].Find(0, , , xlWhole)
  If Not c Is Nothing Then
  x = Cells(Rows.Count, 1).End(3).Row
  Range("A" & c.Row & ":aq" & x).Clear
 End If

 

[Lone-wolf]

Re : aide pour optimisation du code vba

Bonsoir laetitia, cathodique


@cathodique: effectivement il y a 43 colonnes vu qu'il note cells(i, 43).



A+

 

[Dranreb]

Re : aide pour optimisation du code vba

Bonsoir.
À essayer aussi :

Sub SupprimerLignes()
LignesOùRelat(Rows(2), "AQ", "=", 0).Delete
End Sub

Rem. ——— FONCTIONS 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

 

[Lone-wolf]

Re : aide pour optimisation du code vba

Re à tous

juste une question: comment écrire la ligne de de code pour savoir le nom de la colonne à partir de sont numéro, mais à partir de 27; puisqu'on sais que de 1 à 26 correpondent les colonnes A à Z.



A+

 

[Dranreb]

Re : aide pour optimisation du code vba

Je ne sais si la question s'adresse à moi, mais au cas où :
Le second paramètre de la fonction LigneOùRelat supporte aussi bien un numéro qu'un entête de colonne.
Pour des cas plus tordus il y a la fonction LignesOùCondR1C1 qui permet de spécifier une expression logique en notation R1C1.

 

[Lone-wolf]

Re : aide pour optimisation du code vba

Re Dranreb,

merci mais, sans vouloir t'offenser, un exemple vaut mieux que les paroles non? Ceci dit ce n'es pas grave, j'ai trouvé.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
lig = Range("b65536").End(xlUp).Row

For x = 2 To 62
lig = lig + 1

'NUMÉRO COLONNE
Cells(x, 2) = lig - 1

'NOM COLONNE
Cells(x, 3) = Replace(Left(Columns(lig - 1).Address, InStr(Columns(lig - 1).Address, ":") - 1), "$", "")
Next x
Cancel = True
End Sub

A+

 

[Dranreb]

Re : aide pour optimisation du code vba

Sinon j'ai ces 2 fonctions dans un coin, mais je n'en ai jamais eu besoin :

Function EntCol(ByVal N As Long) As String
Do: N = N - 1: EntCol = Chr$(N Mod 26 + 65) & EntCol: N = N \ 26: Loop Until N = 0
End Function
Function ColEnt(ByVal C As String) As Long
Dim P As Long: For P = 1 To Len(C): ColEnt = ColEnt * 26 + Asc(UCase(Mid$(C, P, 1))) - 64: Next P
End Function

Pour en revenir au problème de supprimer plus vite les lignes avec 0 en colonne AQ soit 43 on pouvait aussi faire:

LignesOùRelat(Rows(2), 43, "=", 0).Delete

Ou bien :

LignesOùCondR1C1(Rows(2), "RC43=0").Delete

 

[jp14]

Re : aide pour optimisation du code vba

Bonjour à tous


En reprenant l'idée de Lone-wolf (première réponse), ci dessous un code relativement rapide.
La colonne B contient des valeurs ou rien.
La colonne a contient des données.

Sub Suprimer2(Nomfeuille1 As String)
Dim Cel1 As Range
Dim S1 As Worksheet
Dim Li1 As Long, Li2 As Long

If Nomfeuille1 <> "" Then
'suppression des lignes si la cellule de la colonne B est vide
    Set S1 = Wb.Worksheets(Nomfeuille1)
    Set Cel1 = S1.Range("b:b").SpecialCells(xlCellTypeBlanks)'Cellules vides
    Cel1.Delete Shift:=xlUp
' suppression des lignes restantes
    Set Cel1 = S1.Range("b:b").SpecialCells(xlCellTypeBlanks)
    Li1 = Cel1.Row
    Set Cel1 = S1.Range("a:a").SpecialCells(xlCellTypeLastCell)'Dernière cellule dans la plage utilisée
    Li2 = Cel1.Row
    S1.Rows(Li1 & ":" & Li2).Delete Shift:=xlUp
End If

Bonne journée

JP

 

[maspi69]

Re : aide pour optimisation du code vba

Bonjour à tous.


Un grand merci pour les solutions proposées.

J'ai retenue celle basée sur les filtres.
Le temps de traitement passe à 3 secondes (avec le code de cathodique que j'ai repris pratiquement tel que).

jp14, ton code est aussi très efficace, mais un poil moins rapide que l'autre. Enfin cela se joue à la seconde pour 80 000 lignes, donc pour mois vu ce que j'avais écris, cela reste super.

Merci aussi aux autres contributeurs, grâce à qui j'ai pu apprendre des choses.