Suppression de ligne sous condition Macros VBA
Résolu/Fermé
CamdenTown
Messages postés
37
Date d'inscription
mercredi 16 décembre 2015
Statut
Membre
Dernière intervention
6 février 2017
-
6 janv. 2016 à 21:33
CamdenTown Messages postés 37 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 6 février 2017 - 11 janv. 2016 à 10:04
CamdenTown Messages postés 37 Date d'inscription mercredi 16 décembre 2015 Statut Membre Dernière intervention 6 février 2017 - 11 janv. 2016 à 10:04
A voir également:
- Supprimer lignes excel avec condition vba
- Supprimer une page word - Guide
- Supprimer compte instagram - Guide
- Liste déroulante excel - Guide
- Excel cellule couleur si condition texte - Guide
- Aller à la ligne excel - Guide
3 réponses
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 303
7 janv. 2016 à 17:43
7 janv. 2016 à 17:43
Bonsoir
proposition ci dessous
colonnes A et B traitées indépendamment (j' aimerai si possible appliquer le filtre sur une colonne precise et non sur toute la feuille).
tes 5137 lignes traitées en 0,06 secondes
proposition ci dessous
colonnes A et B traitées indépendamment (j' aimerai si possible appliquer le filtre sur une colonne precise et non sur toute la feuille).
tes 5137 lignes traitées en 0,06 secondes
Option Explicit
Const Seuil As Long = #12/1/2015# 'format UK;=1/12/2015 format FR
'--------------------------------
Sub Supprimer_sous_conditions()
Dim Derlig As Integer, T_in, Cptr As Integer
Dim T_date, Cptd As Integer, T_cinq, Cptq As Integer
Dim start As Single
'------------------------initialisations
start = Timer
Application.ScreenUpdating = False 'fige l'écran: rapidité, confort
With ActiveSheet ' plusieurs feuilles
Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
T_in = .Range("A2:B" & Derlig)
ReDim T_date(1 To UBound(T_in))
ReDim T_cinq(1 To UBound(T_in))
'-------------------------Traitements
For Cptr = 1 To UBound(T_in)
'Traitement des dates
If T_in(Cptr, 1) >= Seuil Then
Cptd = Cptd + 1
T_date(Cptd) = T_in(Cptr, 1)
End If
'traitement des ref
If T_in(Cptr, 2) Like "5" & "*" Then
Cptq = Cptq + 1
T_cinq(Cptq) = T_in(Cptr, 2)
End If
Next
'-------------------------Restitution
'nettoyage
.Range("A2:B" & 20000).Clear
'dates
.Range("A2").Resize(UBound(T_date), 1) = Application.Transpose(T_date)
.Range("A2:A" & UBound(T_date) - 1).Borders.Weight = xlThin
'ref
.Range("B2").Resize(UBound(T_cinq), 1) = Application.Transpose(T_cinq)
.Range("B2:B" & UBound(T_cinq) - 1).Borders.Weight = xlThin
End With
Application.ScreenUpdating = True
MsgBox Derlig & " lignes traitées en " & Timer - start & " sec."
End Sub
8 janv. 2016 à 07:17
j'ai suivi la demande "colonne par colonne" mais ça me parait quand même bizarre...
8 janv. 2016 à 10:44
C'est deja beaucoup mieux vraiment un grand merci !
Cependant je vois que c'est pas encore parfait au niveau des dates et il me reste des cases vides dans les deux colonnes ce que j'aimerai supprimer aussi...