XL 2010 Supprimer des lignes rapidement en vba

xUpsilon à dit:

Bonjour,

Une idée comme ça :
1) placer les données du tableau dans un Array VBA
2) ClearContents la feuille
3) réinsérer uniquement les lignes de l'array intéressantes

Bonne journée,

Cliquez pour agrandir...

xUpsilon à dit:

Bonjour,

Essaye avec ce que j'ai mis dans le Module2 et dis moi si ça te va.

Bonne journée,

Cliquez pour agrandir...

xUpsilon à dit:

Bonjour,

VB:

'Définition des constantes pour fixer la plage de données à traiter
Const nPremLig As Integer = 4
Const sPremCol As String = "B"
Const sDerCol As String = "AB"

Sub SupprLig()

Dim tablo As Variant
Dim nDerLig, nLigInc As Integer

'Désactivation de l'update visuel et du calcul automatique pour la performance
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Recherche de la dernière ligne de la plage de données à traiter
nDerLig = Feuil5.Range(sPremCol & Rows.Count).End(xlUp).Row
'Export des données de la feuille vers un Array
tablo = Feuil5.Range(sPremCol & nPremLig & ":" & sDerCol & nDerLig).Value
'On nettoie la feuille
Feuil5.Range(sPremCol & nPremLig & ":" & sDerCol & nDerLig).ClearContents

'Pour chaque ligne du tableau (LBound = première ligne et UBound = dernière ligne du tableau )
For nLig = LBound(tablo) To UBound(tablo)
    'Sur la ligne observée, on cherche dans la dernière colonne de l'Array (l'équivalent de la colonne AB) si il y a la valeur "A supprimer"
    If tablo(nLig, UBound(tablo, 2)) <> "A supprimer" Then
        'Si la valeur en AB n'est pas "A supprimer", on exporte la ligne de l'Array dans la feuille Excel à la dernière ligne remplie +1
        For nCol = LBound(tablo, 2) To UBound(tablo, 2)
            Feuil5.Cells(nLigInc + nPremLig, nCol + Asc(sPremCol) - 65) = tablo(nLig, nCol)
        Next nCol
        'Augmentation de l'incrément de suivi de ligne Excel à remplir (distinction entre nLig qui boucle sur les lignes de l'array et nLigInc qui indique la ligne de la feuille Excel à remplir)
        nLigInc = nLigInc + 1
    End If
Next nLig

'Réactivation de l'update visuel et du calcul automatique
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Bonne journée,

Cliquez pour agrandir...