XL 2010 VBA-Fonction delete row

[Vero2782]

Bonjour,

Je me suis monté une Macro qui delete chaque ligne qui ne contient pas le nom du client enregistré dans une variable.

Elle est super longue à rouler. C'est un fichier qui peut contenir plus de 38 000 lignes et je fait rouler la macro pour ressortir au maximum 1000-2000 lignes.

La seule solution que je vois pour le moment est de changer ma macro complètement. : Au lieu de supprimer, je pourrait aller sélectionner le bon client, le copier dans un autre fichier et remonter le TCD de zéro. mais j'ai jamais fait de macro pour remonter des TCD... Ca me prendra quelques heures surement... !

À moins qu'il y ai un truc vite fait pour que ma macro aille plus vite....

Auriez-vous un truc pour quelle aille plus vite ?

J'utilise déjà l'Option Explicit.

Merci beaucoup

Véro

Ma macro ressemble à ceci: .
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row

For i = DerniereLigne To 2 Step -1
If Worksheets("rawgb").Cells(i, 9) <> ClientName Then Worksheets("rawgb").Rows(i).Delete
Next i

 

[DoubleZero]

Bonjour, Vero2782, le Forum,

...Auriez-vous un truc pour quelle aille plus vite ?
J'utilise déjà l'Option Explicit...

L'emploi de "Option Explicit" ne permet pas au code d'agir plus rapidement mais rend obligatoire la déclaration des variables.

Pourquoi ne pas utiliser le filtre automatique pour supprimer, ensuite, les valeurs indésirables ?

A bientôt

 

[Dranreb]

Bonjour.
Essayez comme ça :

LignesOùRelat(Worksheets("rawgb").Rows(2), 9, "<>", ClientName).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

 

[Yurperqod]

Bonjour le forum

Sans fichier exemple, j'ai testé comme j'ai pu

Sub test()
Dim DerniereLigne As Long
'Dim i As Long
Dim ClientName As String
'***
'macro d'origine
''DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
''For i = DerniereLigne To 2 Step -1
''If Worksheets("rawgb").Cells(i, 9) <> ClientName Then Worksheets("rawgb").Rows(i).Delete
''Next i
'***
DerniereLigne = Range("A" & Rows.Count).End(xlUp).Row
ClientName = "toto" ' à supprimer dans le fichier original
Worksheets("rawgb").Range("$I$1:$I" & DerniereLigne).AutoFilter _
    Field:=1, _
    Criteria1:="<>" & ClientName
Worksheets("rawgb").AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Worksheets("rawgb").ShowAllData
End Sub

Méthode qui emploie le filtre automatique (comme l'a précédemment suggéré DoubleZéro)

 

[Vero2782]

Bonjour,

Bonne idée pour le filtre automatique, je vais essayer ça cet après-midi. Désolée pour le fichier non-joint, je traite des données confidentielles alors j'ai toujours de la difficultée à joindre mes fichiers, il faudrait que je les transforme beaucoup.

Je vous donne des nouvelles sous peu !

Encore Merci !

Véro

 

[Vero2782]

Bonjour à tous !
Merci merci merci ! Ça fonctionne comme un charme !