[XL-2000] Supprimer les zero d'une sélection

[M_saun]

Bonjour,

J'ai juste un petit soucis en vba.

J'ai une selection composée de chiffres.
Celle selection ressemble à ça :

0 0 0 0 0 12 13 14 15 16 17 18 19 0 0 0 0 0 0 0 0 CASE VIDE

Et ce que je veux faire c'est supprimer les zéro ( en rouge) jusqu'à la premiere case vide.

Pourriez m'indiquer comment je peux faire ?

Merci pour votre aide

J'ai commencé VBA il y deux jours.

[bbil]

Bonjour,

tu peu être plus clair sur ce que tu appelle une sélection ? tu sélectionne quoi ? comment?

[jfontaine]

Bonjour

Le code ci dessous traite la première ligne de la feuille

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim c As Integer
 
'Derniere colonne utilisée
c = Rows(1).End(xlToRight).Column
 
'Pour chaque cellule on verifie si =0
For c = Rows(1).End(xlToRight).Column To 1 Step -1
    If Cells(1, c).Value = 0 Then
        Cells(1, c).Value = ""
    Else
        'si pas = 0 alors on sort de la boucle
        Exit For
    End If
Next c

[M_saun]

Merci ça me donne une bonne piste.

Pour détecter la premirère case sur laquelle il faut agir je vais faire ce test :

Si (Valeur de la case courante Different de zero) ET (que la case juste après a droite est égale à zéro)

alors je récupère l'adresse de la case a zero et je rajoute ton code ensuite qui va supprimer les 0.

ça se tient ?

[ZebreLoup]

Ou alors, tu pars de la droite et tu effaces la cellules tant qu'il y a des 0

[jfontaine]

Hello Zebreloup,

Ou alors, tu pars de la droite et tu effaces la cellules tant qu'il y a des 0

C'est ce que fait ma proposition (si ce n'est une remise a blanc et non une suppression)

[ZebreLoup]

Pas exactement, si tu regardes bien son exemple, il ne veut effacer (ou mettre à blanc, pour moi c'était pareil, un abus de langage de ma part) que les 0 de droite. D'où un While plutôt qu'un For

En reprenant ton code

Code :

1
2
3
4
5
6
7
8
9
10
Dim c As Range
 
'Derniere colonne utilisée
Set c = Rows(1).End(xlToRight)
 
'Pour chaque cellule on verifie si =0
Do While c.Value = 0 And c.Column >= 1
  c.Value = ""
  If c.Column > 1 Then Set c = c.Offset(0, -1)
Loop

[jfontaine]

il ne veut effacer (ou mettre à blanc, pour moi c'était pareil, un abus de langage de ma part) que les 0 de droite.

C'est pourtant bien ce que fait mon code, puisque l'on sort de la boucle des que la valeur est différente de 0.

cela dit, il y a plusieurs façon d'arriver à ce que souhaite M_saun

[ZebreLoup]

Toutes mes excuses, j'avais pas vu le Else.
Je le referais plus, promis !

[M_saun]

Je vois ça

Mais du coup, comment je peux me placer sur la bonne ligne ?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub TEST()
 
    Dim Maximum As Double
    Dim c As Integer
 
 
    ' Cherche une cellule où est marquée Total
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(1, 1).Range("A1", "A2").Select
    Selection.Copy
    ActiveCell.Offset(5, 0).Range("A1").Select
    ActiveSheet.Paste
 
 
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(2, 2).Range("A1").Select
    Range(ActiveCell, ActiveCell.End(xlToRight)).Select
 
    ' Premiere Action : trouver la valeur max
    Maximum = Application.WorksheetFunction.Max(Range(ActiveCell, ActiveCell.End(xlToRight)))
 
    ' Deuxième action : Prendre l'adresse de la dernière colone de cette selection
    Address_der_cumul = ActiveCell.End(xlToRight).Offset(5, 0).Address
    Address_der_bcwp = ActiveCell.End(xlToRight).Offset(4, 0).Address
 
    ' Calcul % Cumulative
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(7, 2).Select
    ActiveCell.FormulaR1C1Local = "=R[-5]C/" & Maximum
    Selection.AutoFill Destination:=Range(ActiveCell, Address_der_cumul), Type:=xlFillDefault
    Selection.NumberFormat = "0.00%"
    Range(ActiveCell, Address_der_cumul).Select
 
    ' Calcul % BCWP
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(6, 2).Select
    ActiveCell.FormulaR1C1Local = "=R[-5]C/" & Maximum
    Selection.AutoFill Destination:=Range(ActiveCell, Address_der_bcwp), Type:=xlFillDefault
    Selection.NumberFormat = "0.00%"
    Range(ActiveCell, Address_der_bcwp).Select
 
    ' Supprimer les cellules à 0 sur la ligne où j'ai calculé le %BCWP
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(6, 2).Select
 
    'Derniere colonne utilisée
    c = Rows(1).End(xlToRight).Column
 
    'Pour chaque cellule on verifie si =0
    For c = Rows(1).End(xlToRight).Column To 1 Step -1
        If Cells(1, c).Value = 0 Then
            Cells(1, c).Value = ""
        Else
            'si pas = 0 alors on sort de la boucle
            Exit For
        End If
    Next c
 
 
 
 
End Sub

[jfontaine]

Si la cellule active se situe sur la bonne ligne

Code :

1
2
3
4
5
6
7
8
    For c = Rows(Activecell).End(xlToRight).Column To 1 Step -1
        If Cells(Activecell, c).Value = 0 Then
            Cells(Activecell, c).Value = ""
        Else
            'si pas = 0 alors on sort de la boucle
            Exit For
        End If
    Next c

Toutes mes excuses, j'avais pas vu le Else.

[M_saun]

J'ai modifié le code en conséquence mais quand je l'execute j'ai un message d'erreur :

Run time error "1004"

Application defined or object defined error

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub TEST()
 
    Dim Maximum As Double
    Dim c As Integer
 
 
    ' Cherche une cellule où est marquée Total
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(1, 1).Range("A1", "A2").Select
    Selection.Copy
    ActiveCell.Offset(5, 0).Range("A1").Select
    ActiveSheet.Paste
 
 
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(2, 2).Range("A1").Select
    Range(ActiveCell, ActiveCell.End(xlToRight)).Select
 
    ' Premiere Action : trouver la valeur max
    Maximum = Application.WorksheetFunction.Max(Range(ActiveCell, ActiveCell.End(xlToRight)))
 
    ' Deuxième action : Prendre l'adresse de la dernière colone de cette selection
    Address_der_cumul = ActiveCell.End(xlToRight).Offset(5, 0).Address
    Address_der_bcwp = ActiveCell.End(xlToRight).Offset(4, 0).Address
 
    ' Calcul % Cumulative
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(7, 2).Select
    ActiveCell.FormulaR1C1Local = "=R[-5]C/" & Maximum
    Selection.AutoFill Destination:=Range(ActiveCell, Address_der_cumul), Type:=xlFillDefault
    Selection.NumberFormat = "0.00%"
    Range(ActiveCell, Address_der_cumul).Select
 
    ' Calcul % BCWP
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(6, 2).Select
    ActiveCell.FormulaR1C1Local = "=R[-5]C/" & Maximum
    Selection.AutoFill Destination:=Range(ActiveCell, Address_der_bcwp), Type:=xlFillDefault
    Selection.NumberFormat = "0.00%"
    Range(ActiveCell, Address_der_bcwp).Select
 
    ' Supprimer les cellules à 0
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(6, 2).Select
    Address_Deb = ActiveCell.Address
 
 
    'Pour chaque cellule on verifie si =0
    For c = Rows(ActiveCell).End(xlToRight).Column To 1 Step -1
        If Cells(ActiveCell, c).Value = 0 Then
            Cells(ActiveCell, c).Value = ""
        Else
            'si pas = 0 alors on sort de la boucle
            Exit For
        End If
    Next c
 
End Sub

[jfontaine]

Pardon, c'est Activecell.Row

[M_saun]

Merci ça marche nickel !!

Est ce qu'il y un moyen d'optimiser mon code ?

Voici le code final qui fonctionne

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub TEST()
 
    Dim Maximum As Double
    Dim c As Integer
 
 
    ' Cherche une cellule où est marquée Total
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(1, 1).Range("A1", "A2").Select
    Selection.Copy
    ActiveCell.Offset(5, 0).Range("A1").Select
    ActiveSheet.Paste
 
 
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(2, 2).Range("A1").Select
    Range(ActiveCell, ActiveCell.End(xlToRight)).Select
 
    ' Premiere Action : trouver la valeur max
    Maximum = Application.WorksheetFunction.Max(Range(ActiveCell, ActiveCell.End(xlToRight)))
 
    ' Deuxième action : Prendre l'adresse de la dernière colone de cette selection
    Address_der_cumul = ActiveCell.End(xlToRight).Offset(5, 0).Address
    Address_der_bcwp = ActiveCell.End(xlToRight).Offset(4, 0).Address
 
    ' Calcul % Cumulative
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(7, 2).Select
    ActiveCell.FormulaR1C1Local = "=R[-5]C/" & Maximum
    Selection.AutoFill Destination:=Range(ActiveCell, Address_der_cumul), Type:=xlFillDefault
    Selection.NumberFormat = "0.00%"
    Range(ActiveCell, Address_der_cumul).Select
 
    ' Calcul % BCWP
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(6, 2).Select
    ActiveCell.FormulaR1C1Local = "=R[-5]C/" & Maximum
    Selection.AutoFill Destination:=Range(ActiveCell, Address_der_bcwp), Type:=xlFillDefault
    Selection.NumberFormat = "0.00%"
    Range(ActiveCell, Address_der_bcwp).Select
 
    ' Supprimer les cellules à 0
    Cells.Find(What:="Total").Select
    ActiveCell.Offset(6, 2).Select
    Address_Deb = ActiveCell.Address
 
 
    'Pour chaque cellule on verifie si =0
    For c = ActiveCell.End(xlToRight).Column To 1 Step -1
        If Cells(ActiveCell.Row, c).Value = 0 Then
            Cells(ActiveCell.Row, c).Value = ""
        Else
            'si pas = 0 alors on sort de la boucle
            Exit For
        End If
    Next c
 
End Sub

[bbil]

Envoyé par M_saun

....
Est ce qu'il y un moyen d'optimiser mon code ?
...

oui il faut supprimer tous les ActiveCell, ActiveSheet ..ainsi que Cells, Range ou tu ne précise pas la feuille concernée ... supprimer tous les Select, Activate et Selection ....