[Toutes versions] supprimer les valeurs zéro

[iliesss]

Bonjour
J’ai une plage (A1:BA3000) qui contienne que des nombres.
J’ai essayé de supprimer les valeurs zéro avec le code suivant

Code :

1
2
3
Range("A1:ba3000").AutoFilter Field:=3, Criteria1:="0,00"
Range("c2:c3000").SpecialCells(xlCellTypeVisible).ClearContents
Range("A1:ba3000").AutoFilter Field:=3

Mon problème ce que je doit répéter ce code 53 fois et je change que le N° de Field (de 3 au 53) et la range ("c2:c3000") au range ("ba2:ba3000")
Question
SVP comment faire pour réduire ces 53 codes pour supprimer les valeurs zéro

[jfontaine]

Bonjour,

Si je comprend bien, tu veux mettre a blanc les cellules qui sont à 0 sur la plage A1 à BA3000

Code :

1
2
3
4
5
6
7
8
9
10
Sub sup()
Dim rg As Range
 
For Each rg In Range("A1:BA3000")
 
    If rg.Value = 0 Then rg.Value = ""
 
Next rg
 
End Sub

[iliesss]

salut
merci pour ton code mais il est lent lorsque la plage est grande
j'ai posté le mémé problème dans un autre forum et Mr ERIC ma envoyé ce code il est rapide

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Sub suppZero()
    Dim f As Long
    Application.ScreenUpdating = False
    For f = 3 To 53
        Range("A1:ba3000").AutoFilter Field:=f, Criteria1:="0,00"
        On Error Resume Next
        [C2].Offset(0, f - 3).Resize(2999, 1).SpecialCells(xlCellTypeVisible).ClearContents
        On Error GoTo 0
        Range("A1:ba3000").AutoFilter
    Next f
    Application.ScreenUpdating = False
End Sub

merci pour toi et merci pour Mr Eric
et si quelqu'un a une meilleure réponse la discussion est ouverte

[jfontaine]

Le code proposé te donne une méthode.

Si tu souhaites optimiser la vitesse il te faudra aussi neutraliser les calculs et l'affichage

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub sup()
Dim rg As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 
 
For Each rg In Range("A1:BA3000")
 
    If rg.Value = 0 Then rg.Value = ""
 
Next rg
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

[iliesss]

merci mon ami
mais mon code proposé est toujours rapide que ton nouveau code

[issoram]

Bonjour,

C'est surtout le fait de travailler range par range (boucle For Each) qui ralentit le code.
Le gain d'efficacité est de l'ordre d'un facteur 20 en travaillant plutôt sur des tableaux.
Je cite cet excellent tutoriel sur la manipulation de tableaux en VBA:

Sur les grandes collections, il convient d'éviter l'énumération qui est très lente.

Du coup le code de Jfontaine adapté:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Dim Tab As Variant, 
Dim i As Long, j As Long
 
Tab = Range("A1:BA3000").Value
 
For i = LBound(Tab, 1) To UBound(Tab, 1)
    For j = LBound(Tab, 2) To UBound(Tab, 2)
        IIf (Tab(i, j) = 0, "", Tab(i, j) )
    Next i
Next j
 
Range("A1:BA3000").Value = Tab
 
Application.ScreenUpdating = True  ' plus vraiment utile ici étant donné que l'affectation
'se fait d'un coup sur la plage entière. Mais ça ne coûte rien de le laisser.
Application.Calculation = xlCalculationAutomatic  ' idem

Cordialement.