Macro modification de formule de calcul

Résolu
Vinz -  
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   -
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,

A voir également:

3 réponses

eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
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
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 315
 
Eric, t'es trop rapide pour moi: très belle procédure avec le coup du A/B-1sur lequel je m'attardais avec un InstRrev...!
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
;-)
trop rapide.... j'ai réfléchi qu'on pouvait la rendre plus générale en recopiant la formule originale dans le résultat du test faux.

version2:
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, "+", ";")
            formule = Replace(formule, "*", ";")
            formule = Replace(formule, "=", "")
            param = Split(formule, ";")
                c.Formula = "=if(" & param(1) & "=0,0," & Mid(c.Formula, 2, 250) & ")"
        End If
    Next c
End Sub
0
Vinz
 
Merci Eric! Cette macro est très relevé pour moi ;-) je vais l'essayer desuite. Par contre je peux la lancer sans modification sur une de mes fiches à modifier? Ai-je besoin de renseigner dans une liste toutes les cellules concernées? J'avoue que je me perd un peu dans ta macro.... :) en tout cas je te remercie de te pencher sur mon problème!
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
non, tu sélectionnes la plage à traiter et tu lances.
Si dans ta plage tu n'as pas de formules d'un autre type ça devrait aller. Sinon il faudra éventuellement ajouter des tests.
On peut aussi définir une plage fixe et traiter toutes les feuilles si tu en as beaucoup...
Contrôle le résultat avant de sauvegarder et aies toujours une copie de l'original en secours (à garder plusieurs semaines...)
0
Vinz
 
Bonjour,

En fait si j'ai d'autres formules d'un autre type dans ces feuilles, donc peut être mettre une condition. Je l'ai testé hier soir, ca ne m'a rien changé dans ma feuille test, et aucun message d'erreur.
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
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



0
Morgothal Messages postés 1236 Date d'inscription   Statut Membre Dernière intervention   183
 
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+
-2
Bidouilleu_R Messages postés 1181 Date d'inscription   Statut Membre Dernière intervention   295
 
ou encore
' écris ("e8") mais tu peux mettre autre chose ;-)


Range("e8").FormulaLocal = "=si(c305=0;0;c14/c305)"

mais j'ajouterai qu'il te faut au minimum 3 boucles
une pour les fichiers, une pour les feuilles, une pour les cellules.
Bon courage
0
Morgothal Messages postés 1236 Date d'inscription   Statut Membre Dernière intervention   183
 
C'est vrai que le ActiveCell n'est pas la meilleure solution

Dim compteur as Integer

For compteur=1 to 50
Range("e" & compteur & "").FormulaLocal = "=si(c305=0;0;c14/c305)"
Next

ça peut être bien :)
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 315
 
bonjour à tous,

tes fichiers sont ils dans le m^me répertoire? sont ils les seuls dans ce répertoire et si non, ont ils une partie de leurs noms commune (par ex: anneeblabla.xls, le générique étant "annee")

donnes les adresses d'écriture de tes nouvelles formules(par ex E8,E9 comme le dit Bidouilleu (salut)) ?
0
Vinz
 
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,
0
Vinz
 
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?
0