une routine qui suprime des lignes

Le
f4crw
Bonjour à tous,

Je constate que sur ce forum il y a des pros, donc comme je ne suis qu'un d=
ébutant je fais encore appel à vous.
J'ai fait cette macro pour supprimer les lignes (très nombreuses) inf=
érieures à une certaine valeur sur des fichiers comportant une gr=
ande quantité de lignes (de 3000 à 15000 lignes), il s'avère=
que cette opération est très longue.

Pouvez_vous m'aider à rendre cette opération plus courte en modif=
iant ce bricolage.



Sub Suppression_Des_Lignes()
'
'
Sheets("Feuil1").Select
Application.ScreenUpdating = False

Application.Goto Reference:="Vitesse_de_décollage"
Vitesse = ActiveCell.Value
Range("A2").Select
début:
If Not (IsNumeric(ActiveCell.Offset(0, 4).Value)) Then
Temp = MsgBox(" Cette ligne contient des valeurs non numérique en co=
lonne D,E ou F !", vbOKOnly + vbDefaultButton1 + vbCritical, " Très =
important !")
Call Message1
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value = "" Then
Call Alerte3
ActiveSheet.Shapes("Bouton Décoder").visible = True
Range("A2").Select
Call Validation_Feuil1
Call Copie_dans_Feuille_Trace
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value < Vitesse Then
ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Delete Shift:=xlUp
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
GoTo début
Range("A2").Select
ActiveSheet.Shapes("Bouton Ouvrir").visible = True

End Sub

Merci d'avance

Régis
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
f4crw
Le #26420119
Le dimanche 11 décembre 2016 05:01:09 UTC+1, f4crw a écrit :
Bonjour à tous,
Je constate que sur ce forum il y a des pros, donc comme je ne suis qu'un débutant je fais encore appel à vous.
J'ai fait cette macro pour supprimer les lignes (très nombreuses) in férieures à une certaine valeur sur des fichiers comportant une g rande quantité de lignes (de 3000 à 15000 lignes), il s'avèr e que cette opération est très longue.
Pouvez_vous m'aider à rendre cette opération plus courte en mod ifiant ce bricolage.

Sub Suppression_Des_Lignes()
'
'
Sheets("Feuil1").Select
Application.ScreenUpdating = False
Application.Goto Reference:="Vitesse_de_décollage"
Vitesse = ActiveCell.Value
Range("A2").Select
début:
If Not (IsNumeric(ActiveCell.Offset(0, 4).Value)) Then
Temp = MsgBox(" Cette ligne contient des valeurs non numérique en colonne D,E ou F !", vbOKOnly + vbDefaultButton1 + vbCritical, " Trè s important !")
Call Message1
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value = "" Then
Call Alerte3
ActiveSheet.Shapes("Bouton Décoder").visible = True
Range("A2").Select
Call Validation_Feuil1
Call Copie_dans_Feuille_Trace
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value < Vitesse Then
ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Delete Shift:=xlU p
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
GoTo début
Range("A2").Select
ActiveSheet.Shapes("Bouton Ouvrir").visible = True
End Sub
Merci d'avance
Régis

Re Bonjour à tous,
Je n'ai pas essayé peut-être avec un filtre sur la colonne et une suppression des lignes visible ?
Régis
?K?
Le #26420136
Bonjour
D'après f4crw
Le dimanche 11 décembre 2016 05:01:09 UTC+1, f4crw a écrit :
Bonjour à tous,
Je constate que sur ce forum il y a des pros, donc comme je ne suis qu'un
débutant je fais encore appel à vous. J'ai fait cette macro pour supprimer
les lignes (très nombreuses) inférieures à une certaine valeur sur des
fichiers comportant une grande quantité de lignes (de 3000 à 15000
lignes), il s'avère que cette opération est très longue.
Pouvez_vous m'aider à rendre cette opération plus courte en modifiant ce
bricolage.
Sub Suppression_Des_Lignes()


'
'
Sheets("Feuil1").Select
Application.ScreenUpdating = False
Application.Goto Reference:="Vitesse_de_décollage"
Vitesse = ActiveCell.Value
Range("A2").Select
début:
If Not (IsNumeric(ActiveCell.Offset(0, 4).Value)) Then
Temp = MsgBox(" Cette ligne contient des valeurs non numérique en colonne
D,E Cou F !", vbOKOnly + vbDefaultButton1 + vbCritical, " Très important
!") Eall Message1 xit Sub
End If
If ActiveCell.Offset(0, 4).Value = "" Then
Call Alerte3
ActiveSheet.Shapes("Bouton Décoder").visible = True
Range("A2").Select
Call Validation_Feuil1
Call Copie_dans_Feuille_Trace
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value < Vitesse Then
ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Delete Shift:=xlUp
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
GoTo début
Range("A2").Select
ActiveSheet.Shapes("Bouton Ouvrir").visible = True
End Sub

Je n'ai pas essayé peut-être avec un filtre sur la colonne et une
suppression des lignes visible ?


idées en vrac
si tu peux retrouver l'ordre initial par tri,
c'est-à-dire tu as une colonne de références par ordre croissant
fais plutôt un tri
ça te permettrait de supprimer en une seule fois (et tu repères les
bornes des lignes avec equiv sur une plage de ta colonne)
si tu n'en as pas je te conseille d'en créer une si c'est possible
ensuite tu remets dans l'ordre et tu fais tourner ta boucle... ou pas
;-)
pour la présence du vide et des valeurs non numériques si c'est juste
la présence qui t'intéresse tu peux le faire avant de remettre dans
l'ordre (tout ça sera à la fin) donc tu repères la dernière valeur
numérique avec equiv (tu mets par exemple une très grosse valeur genre
1 000000) et tu testes
le vide sera en dernier tu peux faire une boucle (for ou while) en
remontant
(pour le texte aussi d'ailleurs, si je comprends bien ça sera marginal)
au lieu de prendre offset tu pourrais multiplier tes 4 valeurs : une
erreur : y'a autre chose que du nombre
0 : y'a du vide et du nombre
un nombre : c'est ok
et pour tout ça tu repères la ref, tu stockes (tableau ou variable
texte en rajoutant au fur et à mesure) et tu pourras faire tes alertes
à la fin quand tout ça sera retrié
tu alertes sur la ref et si tu veux le nouveau numéro de ligne tu
l'auras avec equiv sur la ref (en ce cas il vaut mieux avoir stocké
tableau)
NB tu peux faire tes tests sur les valeurs de cellule sans sélectionner
forcément celles-ci
tout ça devrait sérieusement accélérer le processus...
(pas sûr pour la multiplication cependant, à tester)
cdlt
--
-
Jacquouille
Le #26420183
Bonsoir,
Si la cellule A ne contient rien (est vide), on efface la ligne.
On commence par la dernière et on revient vers A2 (step-1) car, dès que
Excel a supprimé une ligne, la suivante prend sa place. mais comme cette
ligne a déjà été analysée, on saute une éventuelle ligne vide .
Les Pros auxquels tu fais allusion, conseillent toujours d'éviter les
"select". Cela prend du temps et alourdit l'écriture de la macro.
J'ai mis comme condition à l'effacement que An devait être vide. Rien
n'empêche de mettre une autre condition.
---------------------
Sub supprimer_les_lignes_vides()
derL= Cells(Rows.Count, 1).End(xlUp).Row
For N = derL To 2 Step -1
If Range("A" & N).Value = "" Then Rows(N).Delete
Next
End Sub
----------------------------
Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"f4crw" a écrit dans le message de groupe de discussion :

Bonjour à tous,
Je constate que sur ce forum il y a des pros, donc comme je ne suis qu'un
débutant je fais encore appel à vous.
J'ai fait cette macro pour supprimer les lignes (très nombreuses)
inférieures à une certaine valeur sur des fichiers comportant une grande
quantité de lignes (de 3000 à 15000 lignes), il s'avère que cette opération
est très longue.
Pouvez_vous m'aider à rendre cette opération plus courte en modifiant ce
bricolage.

Sub Suppression_Des_Lignes()
'
'
Sheets("Feuil1").Select
Application.ScreenUpdating = False
Application.Goto Reference:="Vitesse_de_décollage"
Vitesse = ActiveCell.Value
Range("A2").Select
début:
If Not (IsNumeric(ActiveCell.Offset(0, 4).Value)) Then
Temp = MsgBox(" Cette ligne contient des valeurs non numérique en colonne
D,E ou F !", vbOKOnly + vbDefaultButton1 + vbCritical, " Très important
!")
Call Message1
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value = "" Then
Call Alerte3
ActiveSheet.Shapes("Bouton Décoder").visible = True
Range("A2").Select
Call Validation_Feuil1
Call Copie_dans_Feuille_Trace
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value < Vitesse Then
ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Delete Shift:=xlUp
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
GoTo début
Range("A2").Select
ActiveSheet.Shapes("Bouton Ouvrir").visible = True
End Sub
Merci d'avance
Régis
---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
f4crw
Le #26420676
Le dimanche 11 décembre 2016 16:37:19 UTC+1, Jacquouille a écrit  :
Bonsoir,
Si la cellule A ne contient rien (est vide), on efface la ligne.
On commence par la dernière et on revient vers A2 (step-1) car, dà ¨s que
Excel a supprimé une ligne, la suivante prend sa place. mais comme cette
ligne a déjà été analysée, on saute une éve ntuelle ligne vide .
Les Pros auxquels tu fais allusion, conseillent toujours d'éviter le s
"select". Cela prend du temps et alourdit l'écriture de la macro.
J'ai mis comme condition à l'effacement que An devait être vide . Rien
n'empêche de mettre une autre condition.
---------------------
Sub supprimer_les_lignes_vides()
derL= Cells(Rows.Count, 1).End(xlUp).Row
For N = derL To 2 Step -1
If Range("A" & N).Value = "" Then Rows(N).Delete
Next
End Sub
----------------------------
Jacques
" Le vin est au repas ce que le parfum est à la femme."
.
"f4crw" a écrit dans le message de groupe de discussion :
Bonjour à tous,
Je constate que sur ce forum il y a des pros, donc comme je ne suis qu'un
débutant je fais encore appel à vous.
J'ai fait cette macro pour supprimer les lignes (très nombreuses)
inférieures à une certaine valeur sur des fichiers comportant u ne grande
quantité de lignes (de 3000 à 15000 lignes), il s'avère qu e cette opération
est très longue.
Pouvez_vous m'aider à rendre cette opération plus courte en mod ifiant ce
bricolage.

Sub Suppression_Des_Lignes()
'
'
Sheets("Feuil1").Select
Application.ScreenUpdating = False
Application.Goto Reference:="Vitesse_de_décollage"
Vitesse = ActiveCell.Value
Range("A2").Select
début:
If Not (IsNumeric(ActiveCell.Offset(0, 4).Value)) Then
Temp = MsgBox(" Cette ligne contient des valeurs non numérique en colonne
D,E ou F !", vbOKOnly + vbDefaultButton1 + vbCritical, " Très impo rtant
!")
Call Message1
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value = "" Then
Call Alerte3
ActiveSheet.Shapes("Bouton Décoder").visible = True
Range("A2").Select
Call Validation_Feuil1
Call Copie_dans_Feuille_Trace
Exit Sub
End If
If ActiveCell.Offset(0, 4).Value < Vitesse Then
ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Delete Shift:=xlU p
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
GoTo début
Range("A2").Select
ActiveSheet.Shapes("Bouton Ouvrir").visible = True
End Sub
Merci d'avance
Régis
---
L'absence de virus dans ce courrier électronique a été v érifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus

Merci Jaques ça fait mon affaire
Publicité
Poster une réponse
Anonyme