Macro modification de formule de calcul Résolu

Question

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,

Configuration: Windows XP / Internet Explorer 6.0

Morgothal · Answer

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+

eriiic · Answer

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

Patrice33740 · Answer

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

Macro modification de formule de calcul

3 réponses

Discussions similaires

Newsletters