Macro pour effacer de formules si résultats égal zéro....

[Christian0258]

Bonjour à tout le forum,

Je souhaiterais votre aide pour d'écrire une macro....

Cette macro devra effacer des formules dans les colonnes R à AA, si le résultat est égal à zéro. Ces formules sont générer à chaque fois par une autre macro (merci job75).

Merci pour voytre aide si précieuse.

Bien amicalement,
Christian

 

[phlaurent55]

Re : Macro pour effacer de formules si résultats égal zéro....

Bonjour Christian,

voir fichier joint

à+
Philippe

 

[Christian0258]

Re : Macro pour effacer de formules si résultats égal zéro....

Re, le forum, Philippe,

Merci, Philippe, pour ton aide.
C'est ce que je souhaite mais j'ai 500 lignes à traiter et le traitement est très long.
Peux-tu me dire.

Bien à toi,
Christian

 

[sourcier08]

Re : Macro pour effacer de formules si résultats égal zéro....

Bonjour Christian0258, phlaurent55, le forum,

Il te suffit de modifier la plage sélectionnée dans la macro.

range("R1:AA20")

deviendrait :

range("R1:AA500")

si tu as 500 lignes.

D'ajouter :

Application.screenupdating = false

en début de code
puis

Application.screenupdating = true

en fin de code

Sub Bouton1_Clic()
Application.ScreenUpdating = False
For Each cellule In Range("R1:AA500")
If cellule = 0 Then cellule.ClearContents
Next cellule
Application.ScreenUpdating = True
End Sub

 

[Christian0258]

Re : Macro pour effacer de formules si résultats égal zéro....

Re, le forum, Philippe, sourcier08?

Merci, sourcier08, pour les précisions.
En plus pour gagner du temps lors du traitement, je passe en mode CalculManual au début de la macro et remets en CalculAutomatic en fin de macro.

Merci à vous deux.

Bien amicalement,
Christian

 

[job75]

Re : Macro pour effacer de formules si résultats égal zéro....

Bonjour Christian, Philippe, sourcier08,

Ces formules sont générer à chaque fois par une autre macro (merci job75).

Plutôt que d'écrire une nouvelle macro pour effacer les formules, on pourrait peut-être adapter l'autre macro non ?

Il faudrait nous la donner.

A+

 

[sourcier08]

Re : Macro pour effacer de formules si résultats égal zéro....

Après, si c'est juste histoire des zéros qu'il ne veut pas voir affichés, il peut toujours faire une macro à l'ouverture du classeur et une autre à la fermeture.

Private Sub Workbook_Open()
    ActiveWindow.DisplayZeros = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ActiveWindow.DisplayZeros = True
End Sub

Mais adapter la macro d'origine est une excellente solution.

 

[Christian0258]

Re : Macro pour effacer de formules si résultats égal zéro....

Re, le forum, job75,

Effectivement, job75, il s'agit de ta macro "additionner des colonnes". Dans mon appli j'ai, à partir de la colonne AC des formules sur 500 lignes,
et je me suis apperçu que dans ce cas la formule collée, grâce à ta macro, était placée même si il n'y a rien à calculersur les lignes...

Je n'ai pas osé te redéranger, pour te demander de modifier ta macro

Bien à toi,

Merci pour votre aide à tous.

Christian
Sub Additionner()
Application.Calculation = xlManual
Dim r1 As Range, r2 As Range
On Error Resume Next
Set r1 = Application.InputBox("Sélectionnez les colonnes (F à L) à additionner :", "Addition", , , , , , 8)
Set r1 = Intersect(r1.EntireColumn, [F2:L500], ActiveSheet.UsedRange)
If r1 Is Nothing Then Exit Sub
Set r2 = Application.InputBox("Sélectionnez la colonne (R à AA) du résultat :", "Addition", , , , , , 8)
Set r2 = Intersect(r2(1).EntireColumn, [R2:AA500], ActiveSheet.UsedRange)
r2 = "=SUM(" & Intersect(r1, r2(1).EntireRow).Address(0, 0, xlR1C1, , r2(1)) & ")"
r2(1).Select 'facultatif
Application.Calculation = xlAutomatic
End Sub

 

[job75]

Re : Macro pour effacer de formules si résultats égal zéro....

Re,

Christian tu aurais pu continuer le fil d'origine :

https://www.excel-downloads.com/threads/macro-pour-additionner-des-colonnes.202318/

Il suffisait de modifier la formule entrée pour introduire des valeurs d'erreur qu'on efface ensuite :

Sub Additionner()
Dim r1 As Range, r2 As Range, f As String
On Error Resume Next
Set r1 = Application.InputBox("Sélectionnez les colonnes (F à L) à additionner :", "Addition", , , , , , 8)
Set r1 = Intersect(r1.EntireColumn, [F2:L500], ActiveSheet.UsedRange)
If r1 Is Nothing Then Exit Sub
Set r2 = Application.InputBox("Sélectionnez la colonne (R à AA) du résultat :", "Addition", , , , , , 8)
Set r2 = Intersect(r2(1).EntireColumn, [R2:AA500], ActiveSheet.UsedRange)
f = Intersect(r1, r2(1).EntireRow).Address(0, 0, xlR1C1, , r2(1))
Application.ScreenUpdating = False
Application.Calculation = xlManual
r2 = "=IF(SUM(" & f & ")=0,#N/A,SUM(" & f & "))"
r2.SpecialCells(xlCellTypeFormulas, 16).ClearContents 'efface les valeurs d'erreurs
r2(1).Select 'facultatif
Application.Calculation = xlAutomatic
End Sub

Fichier joint.

Edit 1 : pour ne pas voir les #N/A j'ai ajouté Application.ScreenUpdating = False

EDit 2 : tu avais très mal placé le Application.Calculation = xlManual !!!

A+

 

[Christian0258]

Re : Macro pour effacer de formules si résultats égal zéro....

Re, le forum, jo75,

C'est vrai, j'aurais du garder le même fil et je m'en excuse.
Ok pour les deux précisions.

Je te remerci infiniment.

Bien à toi,
Christian

 

[job75]

Re : Macro pour effacer de formules si résultats égal zéro....

Re Christian,

En fait on peut se passer de Application.ScreenUpdating = False en entrant des espaces (donc du texte) à la place des #N/A.

Espaces que bien entendu on supprime ensuite :

Sub Additionner()
Dim r1 As Range, r2 As Range, f As String
On Error Resume Next
Set r1 = Application.InputBox("Sélectionnez les colonnes (F à L) à additionner :", "Addition", , , , , , 8)
Set r1 = Intersect(r1.EntireColumn, [F2:L500], ActiveSheet.UsedRange)
If r1 Is Nothing Then Exit Sub
Set r2 = Application.InputBox("Sélectionnez la colonne (R à AA) du résultat :", "Addition", , , , , , 8)
Set r2 = Intersect(r2(1).EntireColumn, [R2:AA500], ActiveSheet.UsedRange)
f = Intersect(r1, r2(1).EntireRow).Address(0, 0, xlR1C1, , r2(1))
Application.Calculation = xlManual
r2 = "=IF(SUM(" & f & ")=0,"" "",SUM(" & f & "))"
r2.SpecialCells(xlCellTypeFormulas, 2).ClearContents 'efface les espaces
r2(1).Select 'facultatif
Application.Calculation = xlAutomatic
End Sub

De plus les Application.Calculation à mon avis ne servent à rien puisque les formules sont entrées d'un coup et ne sont calculées qu'une seule fois.

Tu as vraiment vu une différence ?

A+

 

[Christian0258]

Re : Macro pour effacer de formules si résultats égal zéro....

Re, le forum, job75,

Je te remercie pour cette version encore améliorée.

Bien à toi,

Salut l'artiste.

Christian

P.S : J'ai enlever le mode "CALCULATION" et après essai ça ne semble pas ralentir les calculs, mais j'ai peu de ligne pour l'instant donc je garde les deux lignes pour éventuellement les remettre en fonction...