Pourqoui mon code ne fonctionne pas

A

Arpette

XLDnaute Impliqué
Bonsoir à tous, j'ai un code qui agit sur une colonne D environ 50000 lignes et qui supprime toutes les lignes dont la valeur ne commence pas par M. Cà fonctionne avec la touche F8 mais pas quand je lance la macro, rien ne se passe.
Merci de votre aide.
@+
Code: 
Sub Suivi_des_PO()
Dim i As Long, oDat()
Dim j As Variant
Dim l As Long
Dim c As Range
Dim r As Range
Dim Départ As String
Dim Départ1 As String
Dim d As Range
Dim e As Range
Dim f As Range
Dim Somme&

With Worksheets("TradeCard")
'Insertion colonne E et constitution de l'OA-Ligne
Application.ScreenUpdating = False
For l = .Range("D65536").End(xlUp).Row To 2 Step -1
If InStr(.Range("D" & l), "M") = 0 Then .Rows(l).Delete
Next l
 
Trier par date Trier par votes
Etienne2323

Etienne2323

XLDnaute Impliqué
Re : Pourqoui mon code ne fonctionne pas

Salut Arpette,
chez moi, ton code fonctionne très bien, à condition de rajouter le
Code: 
End With
et le
Code: 
End Sub
qui manque.

Sinon, voici une autre possibilité pour faire exactement le même traitement.

VB: 
With Worksheets("TradeCard")
    For l = .Range("D65536").End(xlUp).Row To 1 Step -1
        If Left(.Range("D" & l), 1) <> "M" Then .Rows(l).Delete
    Next l
End With

Bonne continuité,

Étienne
 
Vote positif 0 Vote négatif
S

Softmama

XLDnaute Accro
Re : Pourqoui mon code ne fonctionne pas

Bonjour Arpette, Etienne2323,

Ou sinon, en conservant ton Instr, juste à modifier la valeur en rouge
Code: 
Sub Suivi_des_PO()
Dim i As Long, oDat()
Dim j As Variant
Dim l As Long
Dim c As Range
Dim r As Range
Dim Départ As String
Dim Départ1 As String
Dim d As Range
Dim e As Range
Dim f As Range
Dim Somme&

With Worksheets("TradeCard")
'Insertion colonne E et constitution de l'OA-Ligne
Application.ScreenUpdating = False
For l = .Range("D65536").End(xlUp).Row To 2 Step -1
If InStr(.Range("D" & l), "M") = [COLOR="Red"]1[/COLOR] Then .Rows(l).Delete
Next l
en effet Instr renvoie zéro que lorsqu'il ne trouve pas la chaine, renvoie 1 lorsqu'il trouve la chaine en 1ère position.
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Pourqoui mon code ne fonctionne pas

Softmama à dit:
Bonjour Arpette, Etienne2323,

Ou sinon, en conservant ton Instr, juste à modifier la valeur en rouge
Code: 
Sub Suivi_des_PO()
Dim i As Long, oDat()
Dim j As Variant
Dim l As Long
Dim c As Range
Dim r As Range
Dim Départ As String
Dim Départ1 As String
Dim d As Range
Dim e As Range
Dim f As Range
Dim Somme&

With Worksheets("TradeCard")
'Insertion colonne E et constitution de l'OA-Ligne
Application.ScreenUpdating = False
For l = .Range("D65536").End(xlUp).Row To 2 Step -1
If InStr(.Range("D" & l), "M") = [COLOR="Red"]1[/COLOR] Then .Rows(l).Delete
Next l
en effet Instr renvoie zéro que lorsqu'il ne trouve pas la chaine, renvoie 1 lorsqu'il trouve la chaine en 1ère position.
Cliquez pour agrandir...

Bonsoir Etienne, et merci pour ton aide. Je vais tester demain.
@+
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Pourqoui mon code ne fonctionne pas

Arpette à dit:
Bonsoir Etienne, et merci pour ton aide. Je vais tester demain.
@+
Cliquez pour agrandir...
Bonsoir Etienne, j'ai pris ta solution qui fonctionne bien en mettant un end With après next l mais je souhaiterais sortie de la feuille un peu plus loin car je veux insérer une colonne E et ensuite faite une concaténation§. Tu m'as déjà aidé sur ce sujet, çà fonctionne sur d'autres feuilles. Mais là çà tourne en rond
Merci de ton aide
@+

Code: 
Sub Suivi_des_PO()
Dim i As Long, oDat()
Dim j As Variant
Dim l As Long
Dim c As Range
Dim r As Range
Dim Départ As String
Dim Départ1 As String
Dim d As Range
Dim e As Range
Dim f As Range
Dim Somme&

With Worksheets("TradeCard")
Application.ScreenUpdating = False
For l = .Range("D65536").End(xlUp).Row To 1 Step -1
    If Left(.Range("D" & l), 1) <> "M" Then .Rows(l).Delete
Next l
.Columns(5).Insert
.Cells(1, 5) = "PO-LG"
Set c = .[E2]
Do While c.Offset(0, -1) <> ""
    c = Split(c(1, 0), "/")(0) & "-" & Mid(.Range("G" & c.Row).Value, 4, 3)
    Set c = c.Offset(1, 0)
Loop

End With
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Pourqoui mon code ne fonctionne pas

Arpette à dit:
Bonsoir Etienne, j'ai pris ta solution qui fonctionne bien en mettant un end With après next l mais je souhaiterais sortie de la feuille un peu plus loin car je veux insérer une colonne E et ensuite faite une concaténation§. Tu m'as déjà aidé sur ce sujet, çà fonctionne sur d'autres feuilles. Mais là çà tourne en rond
Merci de ton aide
@+

Code: 
Sub Suivi_des_PO()
Dim i As Long, oDat()
Dim j As Variant
Dim l As Long
Dim c As Range
Dim r As Range
Dim Départ As String
Dim Départ1 As String
Dim d As Range
Dim e As Range
Dim f As Range
Dim Somme&

With Worksheets("TradeCard")
Application.ScreenUpdating = False
For l = .Range("D65536").End(xlUp).Row To 1 Step -1
    If Left(.Range("D" & l), 1) <> "M" Then .Rows(l).Delete
Next l
.Columns(5).Insert
.Cells(1, 5) = "PO-LG"
Set c = .[E2]
Do While c.Offset(0, -1) <> ""
    c = Split(c(1, 0), "/")(0) & "-" & Mid(.Range("G" & c.Row).Value, 4, 3)
    Set c = c.Offset(1, 0)
Loop

End With
Cliquez pour agrandir...

Bonsoir Softmama, mais celà ne fonctionne pas quand je rajoute la feuille TradeCard, çà boucle. Sans cette feuille la macro tourne pendand 2'30. Je ne c'est pas qu'est ce qui se passe. A noter que cette feuille fait prède 60000 lignes. Je te joints monfichier allégé.
Merci pour ton aide.
@+
 
Vote positif 0 Vote négatif
S

Softmama

XLDnaute Accro
Re : Pourqoui mon code ne fonctionne pas

Bonsoir Arpette,

Grumpf, j'ai passé plus de temps à attendre que s'exécute la macro qu'à la corriger ! 7000 lignes par onglet, c'est beaucoup pour un fichier de test ^^.
Bref, qques corrections, notamment l déclaré as Range, et modifié ça:
VB: 
For l = .Range("D65536").End(xlUp).Row To 1 Step -1
    If Left(.Range("D" & l), 1) <> "M" Then .Rows(l).Delete
Next l

par:
VB: 
Set l = .Range("C65536").End(xlUp)
Do While l.Row > 1
If InStr(l, "M") <> 1 Then
    l.EntireRow.Delete
    Set l = .Range("C65536").End(xlUp)
Else: Set l = l(0, 1)
End If
Loop

fichier ici
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Pourqoui mon code ne fonctionne pas

Softmama à dit:
Bonsoir Arpette,

Grumpf, j'ai passé plus de temps à attendre que s'exécute la macro qu'à la corriger ! 7000 lignes par onglet, c'est beaucoup pour un fichier de test ^^.
Bref, qques corrections, notamment l déclaré as Range, et modifié ça:
VB: 
For l = .Range("D65536").End(xlUp).Row To 1 Step -1
    If Left(.Range("D" & l), 1) <> "M" Then .Rows(l).Delete
Next l

par:
VB: 
Set l = .Range("C65536").End(xlUp)
Do While l.Row > 1
If InStr(l, "M") <> 1 Then
    l.EntireRow.Delete
    Set l = .Range("C65536").End(xlUp)
Else: Set l = l(0, 1)
End If
Loop

fichier ici
Cliquez pour agrandir...

Bonjour Softmama et merci quelques règlages et ce sera bon. Désolé pour le nombre de ligne.
@+
 
Vote positif 0 Vote négatif
A

Arpette

XLDnaute Impliqué
Re : Pourqoui mon code ne fonctionne pas

Softmama à dit:
Bonsoir Arpette,

Grumpf, j'ai passé plus de temps à attendre que s'exécute la macro qu'à la corriger ! 7000 lignes par onglet, c'est beaucoup pour un fichier de test ^^.
Bref, qques corrections, notamment l déclaré as Range, et modifié ça:
VB: 
For l = .Range("D65536").End(xlUp).Row To 1 Step -1
    If Left(.Range("D" & l), 1) <> "M" Then .Rows(l).Delete
Next l

par:
VB: 
Set l = .Range("C65536").End(xlUp)
Do While l.Row > 1
If InStr(l, "M") <> 1 Then
    l.EntireRow.Delete
    Set l = .Range("C65536").End(xlUp)
Else: Set l = l(0, 1)
End If
Loop

fichier ici
Cliquez pour agrandir...
Bonsoir Softmama, j'ai encore besoin de ton aide.
J'ai deux boucles qui tournent sur 65536 lignes et je souhaitrerais qu'elles s'arrêtent dès que la première cellule est vide.
Voici la première, je remmplace ? par transit
Code: 
With Sheets("5-17")
'remplace ? par Transit
j = 2
For Each j In .Range("W:W")
 If j.Value = "?" Then
   j.Value = "Transit"
 End If
Next j

La seconde transforme les cellules texte en nombre.
Code: 
'transforme les cellules texte en nombre.
oDat = .Columns("K:K").Value
   For i = 1 To UBound(oDat, 1)
      oDat(i, 1) = Replace(oDat(i, 1), ",", ".")
   Next i
   .Columns("K:K").NumberFormat = "0"
   .Columns("K:K").Value = oDat

Merci de ton aide
@+
 
Vote positif 0 Vote négatif
S

Softmama

XLDnaute Accro
Re : Pourqoui mon code ne fonctionne pas

Bonjour Arpette,

Pour la première partie, tu peux très avantageusement remplacer le code par ceci :

Code: 
[COLOR="blue"]Dim [/COLOR]j [COLOR="blue"]As [/COLOR]Range
[COLOR="yellowgreen"]'remplace ? par Transit[/COLOR]
[COLOR="blue"]With [/COLOR]Sheets("5-17").Range([COLOR="darkred"]"W:W"[/COLOR])
    Set j = .Find(What:=[COLOR="darkred"]"?"[/COLOR], LookIn:=xlValues, lookat:=xlWhole)
    [COLOR="blue"]If Not[/COLOR] j Is [COLOR="blue"]Nothing Then[/COLOR]
        Do
            j.Value = [COLOR="darkred"]"Transit"[/COLOR]
            [COLOR="blue"]Set [/COLOR]j = .FindNext(j)
        [COLOR="blue"]Loop [/COLOR][COLOR="blue"]While [/COLOR][COLOR="blue"]Not [/COLOR]j Is [COLOR="blue"]Nothing[/COLOR]
    End [COLOR="blue"]If[/COLOR]
End [COLOR="blue"]With[/COLOR]
End [COLOR="blue"]Sub[/COLOR]


Quant à la deuxième partie, tu peux tester ceci :
Code: 
[COLOR="yellowgreen"]'transforme les cellules texte en nombre.[/COLOR]
[COLOR="blue"]Dim [/COLOR]Plage [COLOR="blue"]As [/COLOR]Range, c [COLOR="blue"]As [/COLOR]Range
On Error [COLOR="blue"]Resume [/COLOR][COLOR="blue"]Next[/COLOR]
[COLOR="blue"]Set [/COLOR]Plage = Range([COLOR="darkred"]"K1:K"[/COLOR] & Range([COLOR="darkred"]"K1"[/COLOR]).End(xlDown).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
[COLOR="blue"]For Each[/COLOR] c [COLOR="blue"]In [/COLOR]¨Plage
    c = Replace(c, [COLOR="darkred"]","[/COLOR], [COLOR="darkred"]"."[/COLOR])
[COLOR="blue"]Next[/COLOR]
Plage.NumberFormat = [COLOR="darkred"]"0"[/COLOR]

Mais bon, j'ai pas pu tester, alors vois si ça fonctionne...
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
103
Latias
L
S
  • Résolu(e)
XL 2016 problème de filtre dans listbox
2 3 4
Réponses
51
Affichages
1 K
saidoush
S
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
202
aziz
A
Y
  • Question
probléme au niveau mon code vba
Réponses
3
Affichages
135
Dranreb
Dranreb
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
231
loreak
L
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
388
Dranreb
Dranreb
M
  • Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
135
Maxou69
M
Chaton0408
  • Question
Microsoft 365 VBA Création Question liste destinataire
Réponses
6
Affichages
170
youky(BJ)
youky(BJ)
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
172
eric72
E
O
  • Question
Microsoft 365 Excel [VBA]. Erreur d’exécution 424 Objet requis sur une concaténation
Réponses
3
Affichages
178
Oneida
Oneida

Membres actuellement en ligne

22 membres et 258 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 405
Messages
2 088 120
Membres
103 731
dernier inscrit
dbsglob