suppression de ligne si cell contient lettre

[Hervé]

Bonjour à tous, je découvre tout juste ce site, et je suis en galere du type 'maitriser une macro excel en qqes heures est facile pour mon boss'

J'ai un tableau d'environ 15000 ligne (le nb de zéros est bon) et je voudrais supprimer les lignes dont la cellule de la colonne F (par exemple) contient une lettre et pas en chiffre en caractère numéro 3.
Je sais pas si je suis très explicite.

bref si F2 = 'BJ55'
je garde la ligne

si F5 = 'BJL4'
je supprime,

je insérer ca dans une macro qui tourne déjà sur le fichier, qqun pour m'aider?

merci d'avance

 

[PascalXLD]

Bonjour

du style

Sub elimine()

Dim x As Long

For x = Range('F65536').End(xlUp).Row To 2 Step -1
If Not IsNumeric(Mid(Range('F' & x), 3, 1)) Then Rows(x).Delete
Next

End Sub


Bon courage

 

[Hervé]

ca marche, c'est d'enfer,

merci beaucoup :woohoo:

 

[_Thierry]

Bonjour Hervé, Pascal, le Forum

Vu qu'on parlait avec 'MrExcel' sur un autre poste de passer tout en Array (Tableau) pour booster un Code, et Vu qu'Hervé parle de 15000 lignes (le nb de zéros est bon !!!)

Voici les deux Macro en départ arrété en course de côte 15000 lignes sur 6 colonnes ....

A vos marques, prèts......... Partez !!!

Sub TheEliminator()
Dim x As Long
Dim ElapsedTime As Double

ElapsedTime = Timer
Application.ScreenUpdating = False

    For x = Range('F65536').End(xlUp).Row To 2 Step -1
    If Not IsNumeric(Mid(Range('F' & x), 3, 1)) Then Rows(x).Delete
    Next

Application.ScreenUpdating = True
MsgBox 'TheEliminator run in ' & Timer - ElapsedTime 
End Sub

Resultat 62.92 secondes (118 secondes sans le ScreenUpdating False)

Option Explicit
Option Base 1

Sub TheTerminator()
Dim PlageSource As Variant
Dim PlageCible() As Variant
Dim i As Long, x As Long
Dim C As Byte
Dim ElapsedTime As Double

ElapsedTime = Timer
x = 1

With ActiveSheet
PlageSource = .Range('A1:F' & .Range('F65536').End(xlUp).Row)
End With

For i = 1 To UBound(PlageSource)
    If IsNumeric(Mid(PlageSource(i, 6), 3, 1)) Then
      ReDim Preserve PlageCible(UBound(PlageSource), 6)
        For C = 1 To 6
        PlageCible(x, C) = PlageSource(i, C)
        Next
    x = x + 1
    End If
Next i

Worksheets.Add 'Ici je crée un nouvelle feuille à la volée
Range(Cells(1, 1), Cells(x, 6)) = PlageCible

MsgBox 'TheTerminator run in ' & Timer - ElapsedTime
End Sub

Resultat 0.22 seconde

Y a pas photo !

Bonne Fin d'Aprèm
@+Thierry

 

[Hervé]

merci pour ton code thierry, mais j'ai peur de pas y comprendre grand chose. en fait, l'exemple que j'ai donné etait un peu stupide, puisque je veux vérifier la colonne E avant de supprimer (pas la F). Avec le premier code j'ai su adapter, mais là je nage un peu... (pourtant ca doit pas etre sorcier)

(autre chose, je ne veux pas créer de nouvelle feuille, les lignes qui ne m'intéressent pas doivent simplement etre supprimées, dans la meme feuille)

j'espere que qqun aura compris ce que je veux dire

en tous cas merci

 

[Hervé]

help..

 

[PascalXLD]

re

Tu veux comparer la colonne E ok mais tu as combien de colonnes en tout ??

 

[Hervé]

normalement j'ai 19 colonnes, mais ca peut varier. en fait, le nombre de lignes et de colonnes varient selon les données que je récupère, mais c'est toujours la colonne E que je veux vérifier (le titre de la colonne, cellule E1, c'est 'coloris')

en fait il faudrait lui dire de prendre en compte toute la plage de données (j'ai essayé avec des end(xlDown) ou autre, mais je suis pas très doué)

si j'ai bien compris le 1er code, il vérifie toutes les lignes en partant de la dernière possible (65536), et pas de la dernière de la plage de données, c'est modifiable aussi ca?

 

[Hervé]

NB: (désolé d'en rajouter...) qd dans une macro je lui dis de supprimer une feuille, a chaque fois que je lance la macro, il me demande si je suis sur de vouloir supprimer la feuille, quel est le code pour éviter ca?

 

[PascalXLD]

Re

Voilà le code de Thierry adapté si je ne me suis pas trompé

Option Explicit
Option Base 1

Sub TheTerminator()
Dim PlageSource As Variant
Dim PlageCible() As Variant
Dim i As Long, x As Long
Dim NbCol As Byte
Dim C As Byte
Dim ElapsedTime As Double

ElapsedTime = Timer
x = 1

With ActiveSheet
NbCol = .Range('A1').End(xlToRight).Column
PlageSource = .Range(Cells(1, 1), Cells(.Range('A65536').End(xlUp).Row, NbCol))
End With

For i = 1 To UBound(PlageSource)
    If IsNumeric(Mid(PlageSource(i, 5), 3, 1)) Then
      ReDim Preserve PlageCible(UBound(PlageSource), NbCol)
        For C = 1 To NbCol
        PlageCible(x, C) = PlageSource(i, C)
        Next
    x = x + 1
    End If
Next i

Worksheets.Add 'Ici je crée un nouvelle feuille à la volée
Range(Cells(1, 1), Cells(x, NbCol)) = PlageCible

MsgBox 'TheTerminator run in ' & Timer - ElapsedTime
End Sub

 

[PascalXLD]

Pour eviter le message d'alerte

avant ton code de suppression

application.displayalerts=false

et juste après

tu remets à true

application.displayalerts=true

 

[Hervé]

merci beaucoup

hum, mais comment je lui dis de me mettre le résultat sur la meme feuille? je veux pas créer de nouvelle feuille... la feuille d'origine ne m'intéresse pas...

 

[PascalXLD]

Re

toujours le code de Thierry légèrement modifié si je ne me suis pas trompé

Option Explicit
Option Base 1

Sub TheTerminator()
Dim PlageSource As Variant
Dim PlageCible() As Variant
Dim i As Long, x As Long
Dim NbCol As Byte
Dim C As Byte
Dim ElapsedTime As Double

ElapsedTime = Timer
x = 1

With ActiveSheet
NbCol = .Range('A1').End(xlToRight).Column
PlageSource = .Range(Cells(1, 1), Cells(.Range('A65536').End(xlUp).Row, NbCol))
End With

For i = 1 To UBound(PlageSource)
    If IsNumeric(Mid(PlageSource(i, 5), 3, 1)) Then
      ReDim Preserve PlageCible(UBound(PlageSource), NbCol)
        For C = 1 To NbCol
        PlageCible(x, C) = PlageSource(i, C)
        Next
    x = x + 1
    End If
Next i

with activesheet
.Range(Cells(1, 1), Cells(.Range('A65536').End(xlUp).Row, NbCol)).clearcontents
.Range(Cells(1, 1), Cells(x, NbCol)) = PlageCible
end with

MsgBox 'TheTerminator run in ' & Timer - ElapsedTime
End Sub

 

[_Thierry]

Bonjour Hervé, Pascal, le Forum

Ok si tu veux travailler sur la même feuille...

Mais ...

Perso, je travaillerai jamais directement sur la Feuille d'origine sans en avaoir un Back-Up...

Sinon voilà le code modifié, en respectant les modifs proposées par Pascal, qui sont....... 'tout à fait @+Thierry' !!! lol

Option Explicit
Option Base 1

Const ColToScan As Byte = 5 '<= Soit 'E'...

Sub TheTerminator()
Dim PlageSource As Variant
Dim PlageCible() As Variant
Dim i As Long, x As Long
Dim NbCol As Byte
Dim C As Byte
x = 1

With ActiveSheet
NbCol = .Range('A1').End(xlToRight).Column
PlageSource = .Range(Cells(1, 1), Cells(.Range('A65536').End(xlUp).Row, NbCol))
End With

For i = 1 To UBound(PlageSource)
    If IsNumeric(Mid(PlageSource(i, ColToScan), 3, 1)) Then
      ReDim Preserve PlageCible(UBound(PlageSource), NbCol)
        For C = 1 To NbCol
        PlageCible(x, C) = PlageSource(i, C)
        Next
    x = x + 1
    End If
Next i

Cells.Clear
Range(Cells(1, 1), Cells(x, NbCol)) = PlageCible
End Sub

En prime j'ai mis en Constante la collone à Scanner, ici 5 soit 'E'.. au cas où tu changes un jour ...

Bonne Journée
@+Thierry

 

[PascalXLD]

Salut Thierry

Cette phrase m'a fait très plaisir

Sinon voilà le code modifié, en respectant les modifs proposées par Pascal, qui sont....... 'tout à fait @+Thierry'

Cela prouve que je progresse B)

Bonne journée