Macro modification de formule de calcul
Résolu/Fermé
Vinz
-
8 juil. 2010 à 15:09
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 9 juil. 2010 à 17:09
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 9 juil. 2010 à 17:09
A voir également:
- Macro formula
- Macro word - Guide
- Macro logiciel - Télécharger - Organisation
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro recorder - Télécharger - Confidentialité
- Macro souris ✓ - Forum Windows
3 réponses
eriiic
Messages postés
24570
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
23 avril 2024
7 213
8 juil. 2010 à 16:58
8 juil. 2010 à 16:58
Bonjour tout le monde,
Une proposition :
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
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
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 775
9 juil. 2010 à 17:09
9 juil. 2010 à 17:09
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...
Limitations : uniquement des cellules de la même feuilles, pas de formules matricielles
- 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
Morgothal
Messages postés
1236
Date d'inscription
jeudi 22 avril 2010
Statut
Membre
Dernière intervention
19 mai 2015
183
8 juil. 2010 à 15:41
8 juil. 2010 à 15:41
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+
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+
Bidouilleu_R
Messages postés
1181
Date d'inscription
mardi 27 mai 2008
Statut
Membre
Dernière intervention
12 juillet 2012
289
Modifié par Bidouilleu_R le 8/07/2010 à 15:47
Modifié par Bidouilleu_R le 8/07/2010 à 15:47
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
' é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
Morgothal
Messages postés
1236
Date d'inscription
jeudi 22 avril 2010
Statut
Membre
Dernière intervention
19 mai 2015
183
8 juil. 2010 à 15:48
8 juil. 2010 à 15:48
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 :)
Dim compteur as Integer
For compteur=1 to 50
Range("e" & compteur & "").FormulaLocal = "=si(c305=0;0;c14/c305)"
Next
ça peut être bien :)
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 303
8 juil. 2010 à 16:01
8 juil. 2010 à 16:01
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)) ?
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)) ?
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,
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?
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?
8 juil. 2010 à 17:07
Modifié par eriiic le 8/07/2010 à 17:21
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:
8 juil. 2010 à 17:23
Modifié par eriiic le 8/07/2010 à 18:12
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...)
9 juil. 2010 à 09:03
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.