Discussion :

[wyzer]

Bonjour,

J'ai voudrait faire une macro qui me supprime une ligne si la cellule de la colonne C et D sont >= 0

Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Colonne C | Colonne D
          |
-334€     |  0€          (on laisse)
0€        |  -100€       (on laisse)
0€        |  0€          (on supprime)
120€      |  0€          (on supprime)
0€        |  40€         (on supprime)

Voici ma macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub TEST()
Application.ScreenUpdating = False
Dim cellule As Variant
For Each cellule In Range("C:D")
If cellule.Offset(0, 0) >= 0 And cellule.Offset(1, 0) >= 0 Then
cellule.EntireRow.ClearContents
End If
Next cellule
Application.ScreenUpdating = True
End Sub

Mais il me mets un message d'erreur

Je ne comprends pas ce qui cloche


Merci par avance

[Minick]

Salut,

Ci-joint une correction, de maniere generale, lorsqu'on veut supprimer
des lignes, il vaut mieux commencer de la derniere ligne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Sub TEST()
    Dim Cpt As Integer
 
    Application.ScreenUpdating = False
        For Cpt = Range("C:D").SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
            If Range("C" & Cpt).Value >= 0 And Range("D" & Cpt).Value >= 0 Then
                Rows(Cpt).Delete
            End If
        Next Cpt
    Application.ScreenUpdating = True
End Sub

[wyzer]

Ca ne fonctionne pas

[Minick]

Pourquoi pas!!!!

J'ai evidemment teste avant de poster, le probleme vient surement d'ailleurs....

Ou est l'erreur, quel est le message (s'il y en a un)??
Les valeurs sont elles bien numerique et non du texte??

[wyzer]

Il s'arrête à la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Cpt = Range("C:D").SpecialCells(xlCellTypeLastCell).Row To 1 Step -1

[le_dilem]

Essaye ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Supprime()
 
Dim I
Dim val
I = 1
 
While Range("C" & I) <> ""
  val = Range("C" & I) + Range("D" & I)
If val >= 0 Then
Rows(I).Select
Selection.Delete Shift:=xlUp
'Range("e" & I) = val
I = I - 1
End If
I = I + 1
 Wend
 
End Sub

[Minick]

Oui mais quel est le message d'erreur??
Depassement de capacite, par exemple, si c'est ca, change Interger en Long

[wyzer]

Minick -> désolé, effectivement le message est bien "dépassement de capacité". J'ai changé en Long, mais il mouline longtemps sans résultat. Donc j'ai été obligé d'arrêté Excel avec le gestionnaire des taches

le_dilem -> pareil, il mouline sans fin


C'est peut-être parce que je suis sous Excel 2000 ?

[le_dilem]

Chez moi ça marche bien
peux que c'est Excel 2000.

Essaye ça pour voir si c'est du à la sélection de la ligne ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Supprime()
 
Dim I
Dim val
I = 1
 
While Range("C" & I) <> ""
  val = Range("C" & I) + Range("D" & I)
If val >= 0 Then
Range("e" & I) = val
I = I - 1
End If
I = I + 1
 Wend

[Minick]

Re,

Est ce qu'il n'y aurai pas de gros temps de calculs.
Si c'est le cas, a chaque suppression d'une ligne un calcul se fait et ca peut etre ton probleme.

Ajoute cette ligne apres Screenupdating = False:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

application.Calculation=xlCalculationManual

et cette ligne avant Screenupdating = True:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

application.Calculation=xlCalculationAutomatic

[wyzer]

Bon, j'ai fait tout ce que tu m'as dit mais ça mouline toujours dans le vide

[wyzer]

C'est bon !!

j'ai modifié ta première proposition en enlevant les calculs comme tu m'as dit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub TEST()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Cpt As Integer
For Cpt = Range("C:D").SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Range("C" & Cpt).Value >= 0 And Range("D" & Cpt).Value >= 0 Then
Rows(Cpt).Delete
End If
Next Cpt
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Par contre comment lui dire de commencer à la ligne 2, car il me supprime aussi ma ligne d'entête

[le_dilem]

Row To 2

[Minick]

re,

Il suffit de s'arreter a la ligne 2 et pas 1 ici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Cpt = Range("C:D").SpecialCells(xlCellTypeLastCell).Row To 2 Step -1

[wyzer]

Merci !!