Macro modification de formule de calcul [Résolu/Fermé]

Signaler
-
Messages postés
8535
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
9 avril 2021
-
Bonjour à tous,

Je fais appel à vos connaissances pour une macro 'mise à jour' on va dire. Je dispose d'une centaine de fichiers Excel avec à l'intérieur une dizaine de feuilles en moyennes. Toutes les feuilles ont la même mise en page.

Dans ces feuilles sont calculés des pourcentages/taux avec les formules suivantes:
- C14/C305
- C14/C305-1
Dans chaque feuilles les mêmes formules ont la même position.

Le problème est que quand le dénominateur est égal à 0 on obtient dans la cellule: #DIV/0!

Or j'ai rajouté dans ce fichier un "delta" qui fait la différence des taux d'une semaine à l'autre (ces fichiers sont mis à jours toutes les semaines et sauvegarder en archive par semaines).

Ma question est donc la suivante: est-il possible de créer une macro me permettant de modifier toutes les formules citées ci-dessus par "SI(C305=0;0;C14/C305)"?

J'essaye, j'essaye mais je ne trouve pas! A part me faire à la main les cellules une par une sachant qu'il y a au moins 50 cellules avec ce genre de formule par feuille.

En vous remerciant d'avance.

Cordialement,

3 réponses

Messages postés
24016
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
18 avril 2021
6 736
Bonjour tout le monde,

Une proposition :
Sub majFormules()
    Dim c As Range, formule As String, param
    For Each c In Selection
        If Left(c.Formula, 1) = "=" And Mid(c.Formula, 2, 2) <> "IF" Then
            formule = Replace(c.Formula, "/", ";")
            formule = Replace(formule, "-", ";")
            formule = Replace(formule, "=", "")
            param = Split(formule, ";")
            If UBound(param) = 1 Then
                c.Formula = "=if(" & param(1) & "=0,0," & param(0) & "/" & param(1) & ")"
            ElseIf UBound(param) = 2 Then
                c.Formula = "=if(" & param(1) & "=0,0," & param(0) & "/" & param(1) & "-" & param(2) & ")"
            End If
        End If
    Next c
End Sub

Traite les formules de la plage sélectionnée.
Les contrôles sont assez réduits, se mefier s'il y a d'autre types de formule dans la plage.
eric
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
16433
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
15 avril 2021
3 164
essai, pb sur CCM ?
Messages postés
24016
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
18 avril 2021
6 736
Des formules inattendues gênaient...
essaie cette version :
Sub majFormules() 
    Dim c As Range, formule As String, param 
    For Each c In Selection 
        If Left(c.Formula, 1) = "=" And Mid(c.Formula, 2, 2) <> "IF" And InStr(c.Formula, "/") > 0 Then 
            'c.Activate 
            formule = Replace(c.Formula, "/", ";") 
            formule = Replace(formule, "-", ";") 
            formule = Replace(formule, "+", ";") 
            formule = Replace(formule, "(", "") 
            formule = Replace(formule, ")", "") 
            formule = Replace(formule, "=", "") 
            param = Split(formule, ";") 
            c.Formula = "=if(" & param(1) & "=0,0," & Mid(c.Formula, 2, 250) & ")" 
            ' mettre ligne suivante en commentaire 
            'c.Interior.ColorIndex = 5 
        End If 
    Next c 
End Sub 

Je l'ai testée en sélectionnant C:E, apparemment c'est ok
Adapte ta macro en sélectionnant ta plage au mieux avant de l'appeler
Pour tester réactive c.Activate et c.Interior.ColorIndex = 5 (avec éventuellement des points d'arret dessus) pour voir les cellules touchées avant et après la modif
eric
Un grand merci eriiic! Ca fonctionne parfaitement, je vais pouvoir l'intégrer dans ma macro.
Je te remercie pour ton aide plus que précieuse.

Cordialement,

vinz
Un grand merci également, michel_m, pour ton implication dans mon problème.
Longue vie à ce forum ;-)

A bientot

Vinz
Messages postés
24016
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
18 avril 2021
6 736
de rien
N'oublie pas de mettre en résolu ;-)
@+
Messages postés
8535
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
9 avril 2021
1 650
Voici un code pour remplacer toutes les occurrences des divisions simples de cellule du type A1/A2 dans toutes les formules (sauf si c'est déjà fait) par =SI(A2=0;0;A1/A2) qui évite le #DIV/0 :
- quel que soit le type d'adressage ($L$C, $LC, L$C et LC)
- quel que soit le nombre de divisions contenus dans les formules
Limitations :
- uniquement pour des cellules de la même feuilles
- pas de formules matricielles
- et toutes celles que j'oublie...


Option Explicit
Option Private Module

Public Sub Test()
  
  Dim wbkCible As Excel.Workbook
  Dim wsh As Excel.Worksheet
  Dim cell As Excel.Range
  Dim cellDep1 As Excel.Range
  Dim cellDep2 As Excel.Range
  Dim formule1 As String
  Dim formule2 As String
  Dim division As String
  Dim adrDep1 As String
  Dim adrDep2 As String
  Dim abs1 As Integer
  Dim abs2 As Integer
  Dim ptr1 As Long
  Dim ptr2 As Long
    
  Application.Calculation = xlCalculationManual
  Application.Cursor = xlWait
  Application.ScreenUpdating = False
   
  Set wbkCible = Application.ActiveWorkbook
  
  'Recherche :
  'Dans chaque feuille
  For Each wsh In wbkCible.Worksheets
    'Dans chaque cellule de la plage utilisée
    For Each cell In wsh.UsedRange
      'Dans les cellules contenant une formule avec division
      If InStr(1, cell.Formula, "/") > 1 And _
         (Left(cell.Formula, 1) = "=" Or Left(cell.Formula, 2) = "{=") Then
        'Pour chaque dividende potentiel
        For Each cellDep1 In cell.Precedents
          'Pour chacun des 4 modes d'adressage du dividende ($L$C $LC L$C LC)
          For abs1 = 1 To 4
            adrDep1 = cellDep1.Address(abs1 = 1 Or abs1 = 2, abs1 = 1 Or abs1 = 3)
            'Pour chaque diviseur potentiel
            For Each cellDep2 In cell.Precedents
              'Pour chacun des 4 modes d'adressage du diviseur
              For abs2 = 1 To 4
                adrDep2 = cellDep2.Address(abs2 = 1 Or abs2 = 2, abs2 = 1 Or abs2 = 3)
                division = adrDep1 & "/" & adrDep2
                ptr1 = 1
                ptr2 = 1
                'Pour chaque occurence de la division dans la formule
                Do
                  formule1 = cell.Formula
                  formule2 = "IF(" & adrDep2 & "=0,0," & division & ")"
                  ptr2 = InStr(ptr1, formule1, formule2)
                  ptr1 = InStr(ptr1, formule1, division)
                  If ptr1 = 0 Then Exit Do  's'il n'en reste pas
                  'Quand le changement n'est pas déjà fait ...
                  If ptr2 = 0 Or ptr1 <> ptr2 + 8 + Len(adrDep2) Then
                    '... modifier et formule et pointer après la modification
                    cell.Formula = Left(formule1, ptr1 - 1) & _
                                   formule2 & _
                                   Mid(formule1, ptr1 + Len(division))
                    ptr1 = ptr1 + Len(formule2)
                  Else
                    '... sinon pointer après la division
                    ptr1 = ptr1 + Len(division)
                  End If
                Loop
              Next abs2
            Next cellDep2
          Next abs1
        Next cellDep1
      End If
    Next cell
  Next wsh

  Application.ScreenUpdating = True
  Application.Cursor = xlDefault
  Application.Calculation = xlCalculationAutomatic
  
End Sub


Limitations : uniquement des cellules de la même feuilles, pas de formules matricielles



Messages postés
1235
Date d'inscription
jeudi 22 avril 2010
Statut
Membre
Dernière intervention
19 mai 2015
171
Bonjour,

Tu peux écrire dans un sub avec une boucle for :

ActiveCell.Formula = "=IF(R[305]C[3]=0,0,R[14]C[3]/R[305]C[3])"

Je pense que c'est ça mais pas sûr...
Essaie quand même ça coute rien :)

A+
Merci pour tous ces conseils!

Le truc c'est que la formule que je vous ai donné dans le premier post est une formule parmis tant d'autres! En fait mes "50 cellules" que je vous ai indiqué reprennent des cellules différentes.

Par exemple actuellement dans un onglet (même emplacement pour tous les autres):
C15= C14/C305
C22=C21/C19
C25=C24/C19
C32=C31/C19
etc...

Je reprend le travail d'une ancienne colaboratrice en fait, et donc toutes les cellules sont déjà renseignées par un calcul.

Est-il possible de se servir de la formule actuellement en place dans chaque cellule et de la transformer avec la condition SI en gardant les même cellules qui qont rattachées?
...je sais pas si je me peux me faire comprendre...
La boucle est déjà OK, j'aimerais y intégrer un morceau dedans pour modifier les formules. Je pensais à faire une liste ARRAY avec toutes les cellules concernées dans l'onglet??

Cordialement,
VOilà en fait il faudrait que la macro prenne la formule actuelle avec les cellules du numérateur et du dénominateur et la transforme avec le SI comme indiquée ci -dessus:
Par exemple: =C14/C305 --> =SI(C305=0;0;C14/C305) pour chaque cellule préalablement inscrite dans une liste avec une boucle.

Qu'en pensez-vous?
Messages postés
16433
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
15 avril 2021
3 164
faire une liste ARRAY

tout à fait

pour alimenter avec les formules existantes
pour transformer tes formules: les formules sont elles toujours du type A/B comme A/B-1 par ex
Messages postés
1235
Date d'inscription
jeudi 22 avril 2010
Statut
Membre
Dernière intervention
19 mai 2015
171
J'en pense que si tu récupères la chaine de caractères après le "/" dans une variable, tu peux tester si elle est différente de 0, et si tu remplaces ou non la formule dans la cellule :)
michel_m: oui mes formules sont toutes du type A/B ou A/B-1 mais avec des cellules différentes dans chaque calcul ,-)

Morgothal: la valeur après le "/" peut être différente chaque semaine suivant les résultats :) et donc je pensais faire la condition dans chque cellule au cas où