Aide sur VBA (Formule Excel trop longue)

Le 30/06/2014 à 15:42

Bonjour,

Tout d'abord, merci à tous ceux qui alimentent ce forum, car ce dernier m'a souvent aidé lorsque je rencontrais des problèmes sur Excel. Cependant, je suis actuellement confronté à un problème et je n'ai pas réussi à trouver la solution sur le forum. Merci d'avance pour votre aide.

Alors voilà, je dois effectuer une somme conditionnelle d'une cellule qui se trouve sur 30 feuilles différentes (oui, oui 30 !).

Evidemment, la somme se trouve sur une "31ème" feuille et elle est conditionnée en fonction de différentes dates.

Actuellement, la formule qui analyse la première feuille ressemble à ça :

=IF(T!B3<'1'!$D$8;IF(T!B3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-T!B3)*'1'!$G$8;IF(T!C3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-'1'!$D$7)*'1'!$G$8;0)))+IF(T!B3<'1'!$J$8;IF(T!B3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-T!B3)*'1'!$M$8;IF(T!C3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-'1'!$J$7)*'1'!$M$8;0)))

il est donc impossible de répéter 30 fois cette formule sur une même case, car Excel est trop limité de ce côté.

J'ai essayé de passer par une somme sur plusieurs onglets mais ça à l'air impossible, car il y a trop d'arguments.

Je voulais donc savoir s'il était possible de passer par VBA pour faciliter la tâche ?

Merci bcp

Le 30/06/2014 à 23:41

Bonsoir,

une proposition

qui met la formule dans la cellules A1 sur la feuille T, remplace 30 fois le nom de la feuille dans la formule,et fait la somme des résultats

Sub test()
With Sheets("T")
f = "=IF(T!B3<'1'!$D$8;IF(T!B3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-T!B3)*'1'!$G$8;IF(T!C3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-'1'!$D$7)*'1'!$G$8;0)))+IF(T!B3<'1'!$J$8;IF(T!B3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-T!B3)*'1'!$M$8;IF(T!C3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-'1'!$J$7)*'1'!$M$8;0)))"
s = 0
For i = 1 To 30
with .range("A1") ' remplacer A1, si A1 ne convient pas
   .Formula = Replace(f, "'1'", "'" & i & "'")
   s = s + .value
end with
Next i
End With
MsgBox "resultat = " & s
End Sub
Le 01/07/2014 à 09:11

Merci beaucoup pour ton aide !

Je vais essayer de comprendre ta formule et l'appliquer.

Encore merci !

Edit:

Je viens de tester ta formule, cependant Excel trouve une erreur dans cette formule :

.Formula = Replace(f, "'1'", "'" & i & "'")

J'ai essayé de bidouiller à partir de ta solution mais je tourne en rond ...

Le 01/07/2014 à 11:52

Bonjour,

essaie ceci

Sub test()
With Sheets("T")
f = "=IF(T!B3<'1'!$D$8;IF(T!B3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-T!B3)*'1'!$G$8;IF(T!C3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-'1'!$D$7)*'1'!$G$8;0)))+IF(T!B3<'1'!$J$8;IF(T!B3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-T!B3)*'1'!$M$8;IF(T!C3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-'1'!$J$7)*'1'!$M$8;0)))"
f = Replace(f, ";", ",")
s = 0
For i = 1 To 30
With .Range("A1") ' remplacer A1, si A1 ne convient pas
  .Formula = Replace(f, "'1'", "'" & i & "'")
   s = s + .Value
End With
Next i
End With
MsgBox "resultat = " & s
End Sub
Le 01/07/2014 à 13:00

Encore merci pour ton aide !

Cette nouvelle formule fonctionne à moitié. En effet, le message dans MsgBox est le bon résultat mais ça affiche un 0 dans la cellule A1 .. Ce n'est pas possible d'avoir le résultat aussi en A1 ?

Merci beaucoup

Edit:

j'ai réussi à afficher la valeur en A1 en modifiant ton code :

Sub testgestion()
With Sheets("T")
f = "=IF(T!B3<'1'!$D$8;IF(T!B3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-T!B3)*'1'!$G$8;IF(T!C3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-'1'!$D$7)*'1'!$G$8;0)))+IF(T!B3<'1'!$J$8;IF(T!B3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-T!B3)*'1'!$M$8;IF(T!C3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-'1'!$J$7)*'1'!$M$8;0)))"
f = Replace(f, ";", ",")
s = 0
For i = 1 To 20
With .Range("A1") ' remplacer A1, si A1 ne convient pas
 .Formula = Replace(f, "'1'", "'" & i & "'")
   s = s + .Value
End With
Next i
End With
Range("A1").Select
Selection.Value = s
MsgBox "resultat = " & s
End Sub

Cependant, cela m'empêche d'étendre la formule à d'autres cellules, car il n'y a pas de formule en A1, seulement le résultat.

Je joins le fichier pour que ça soit plus clair (pour l'instant il n'y a que 20 onglets mais à termes il y en aura 30).

La somme doit s'afficher en B3 et l'idée serait d'étendre la formule pour les autres semaines ...

7gestion-intemporelle.zip (18.75 Ko)
Le 01/07/2014 à 20:24

Bonsoir

solution via une feuille intermédiaire

vérifier si j'ai bien compris.

Sub testgestion()
With Sheets("workspace")
' f=la formule où il faut remplacer le '1' par les valeurs de 1 à 30
f = "=IF(T!B3<'1'!$D$8;IF(T!B3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-T!B3)*'1'!$G$8;IF(T!C3>'1'!$D$7;(MIN('1'!$D$8;T!C3)-'1'!$D$7)*'1'!$G$8;0)))+IF(T!B3<'1'!$J$8;IF(T!B3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-T!B3)*'1'!$M$8;IF(T!C3>'1'!$J$7;(MIN('1'!$J$8;T!C3)-'1'!$J$7)*'1'!$M$8;0)))"
f = Replace(f, ";", ",")
df = 20 'dernière feuille est 20

.Cells(1, 1).Formula = "=Sum(A2:A" & df + 1 & ")" ' résultat pour la colonne 1 est la somme des résultats des formules dans cette colonne
For i = 1 To df ' une formule par feuille
.Cells(i + 1, 1).Formula = Replace(f, "'1'", "'" & i & "'") ' on met la formule en ligne n° de feuille +1

Next i

.Range(.Cells(1, 1), .Cells(df + 1, 1)).Copy .Range(.Cells(1, 2), .Cells(df + 1, 52)) ' on copie la colonne de formules vers la droite pour les 52 périodes.
End With
End Sub
7gestion-intemporelle.zip (53.24 Ko)
Le 02/07/2014 à 15:47

Bonjour,

ça fonctionne parfaitement, merci beaucoup pour ton aide h2so4 !

Rechercher des sujets similaires à "aide vba formule trop longue"