Fonction SommeProd en VBA

Le 27/06/2013 à 15:49

Bonjour,

Je souhaiterai coder la fonction SommeProd mais je n'arrive pas à trouver la bonne syntaxe.

Je vous ai mis en pièce jointe un fichier d'exemple :

En ligne 19 il y a le résultat que je souhaite obtenir en ligne 17 avec l'aide du code vba suivant :

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim j As Long
 Dim plageA As Range, plageB As Range, plageC As Range, plageD As Range
 Dim A1 As Double, A2 As Double, A3 As Double, A4 As Double

 For j = 2 To 52 Step 5

    Set plageA = Range(Cells(1, j + 1), Cells(16, j + 1))
    Set plageB = Range(Cells(1, j + 2), Cells(16, j + 2))
    Set plageC = Range(Cells(1, j + 3), Cells(16, j + 3))
    Set plageD = Range(Cells(1, j + 4), Cells(16, j + 4))

    A1 = Application.Sum("C1:C16")
    A2 = Sommeprod(plageA * plageB)
    A3 = Sommeprod(plageA * plageC)
    A4 = Sommeprod(plageA * plageD)

    Cells(17, j + 1) = A1
    Cells(17, j + 2) = A2 / A1
    Cells(17, j + 3) = A3 / A1
    Cells(17, j + 3) = A4 / A1
Next j

End Sub

Merci pour votre aide

233exemple.zip (13.34 Ko)
Le 27/06/2013 à 17:43

Bonjour,

Un exemple avec SumProduct

990exemple.zip (15.49 Ko)

A+

Le 27/06/2013 à 18:32

Bonjour,

Un truc :

  • Commencer par écrire la formule SOMMEPROD dans une cellule Excel et sélectionner cette cellule.
  • Ouvrir l'éditeur VBA (ALT + F11)
  • Ouvrir la fenêtre d'exécution (CTRL + G).
  • Taper dans cette fenêtre :
Debug.Print ActiveCell.Formula

ou

Debug.Print ActiveCell.Formula R1C1

Ceci donnera la syntaxe à utiliser en VBA.

Le 28/06/2013 à 09:26

Merci!

Par contre y a t'il moyen de réduire le temps de calcul? Parce que sur mon code cela d'applique sur une 60aine de colonnes qui se compose chacune de plus de 400 lignes.

Je peux te mettre le code mais pas le fichier qui l'accompagne!

Option Explicit
                                 '++++++++++++++++++++++++++++++++++++++++++'
                                 '+          FEUILLE MCI LAUNCH            +'
                                 '++++++++++++++++++++++++++++++++++++++++++'

Private Sub Worksheet_Change(ByVal Target As Range)

'=========================================================================================================
'DECLARATION DES VARIABLES
Dim K As Double
Dim LgTablo()
Dim i As Double, j As Long
Dim plageA As Range, plageB As Range, plageC As Range, plageD As Range
Dim A1 As Double, A2 As Double, A3 As Double, A4 As Double

'=========================================================================================================
'FONCTIONS D'OPTIMISATION
  Application.ScreenUpdating = False  ' Empeche la maj de l'écran
  Application.EnableEvents = False    ' Désactive Evenement

'=========================================================================================================
'Création du tableau avec le début et la fin de chaque sous ensemble
LgTablo = Array(8, 90, 104, 162, 174, 181, 193, 197, 209, 263, 275, 321, 333, 357, 369, 378, 390, 396, 408, 463, 475, 490, 502, 514, 526, 527, 539, 542)

' Travail sur les colonnes C à Z
For K = 0 To UBound(LgTablo) Step 2

' Calcul des Masses de la ligne TOTAL
    Cells(LgTablo(K + 1) + 3, "C") = Application.Sum(Range("C" & LgTablo(K) & ":C" & LgTablo(K + 1)))

' Calcul des colonnes U à W
    With Range(Cells(LgTablo(K), "U"), Cells(LgTablo(K + 1), "W"))
      .Formula = "=$C" & LgTablo(K) & "*D" & LgTablo(K)
      .Value = .Value
    End With

' Calcul des masses * coordonnées de la ligne TOTAL
    With Range(Cells(LgTablo(K + 1) + 3, "U"), Cells(LgTablo(K + 1) + 3, "W"))
      .Formula = "=SUM(U" & LgTablo(K) & ":U" & LgTablo(K + 1) & ")"
      .Value = .Value
    End With

' Calcul des CdG pour la ligne TOTAL
    With Range(Cells(LgTablo(K + 1) + 3, "D"), Cells(LgTablo(K + 1) + 3, "F"))
      .Formula = "=U" & LgTablo(K + 1) + 3 & "/$C" & LgTablo(K + 1) + 3
      .Value = .Value
    End With

'Calcul des Inerties de transports (colonne N à P)
    With Range(Cells(LgTablo(K), "N"), Cells(LgTablo(K + 1), "N"))
      .Formula = "=C" & LgTablo(K) & "*((E" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))^2+(F" & LgTablo(K) & "-($F$" & LgTablo(K + 1) + 3 & "))^2)*0.000001"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K), "O"), Cells(LgTablo(K + 1), "O"))
      .Formula = "=C" & LgTablo(K) & "*((D" & LgTablo(K) & "-($D$" & LgTablo(K + 1) + 3 & "))^2+(F" & LgTablo(K) & "-($F$" & LgTablo(K + 1) + 3 & "))^2)*0.000001"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K), "P"), Cells(LgTablo(K + 1), "P"))
      .Formula = "=C" & LgTablo(K) & "*((D" & LgTablo(K) & "-($D$" & LgTablo(K + 1) + 3 & "))^2+(E" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))^2)*0.000001"
      .Value = .Value
    End With

'Calcul des produits d'inertie de transport (colonne Q à S)
    With Range(Cells(LgTablo(K), "Q"), Cells(LgTablo(K + 1), "Q"))
      .Formula = "=C" & LgTablo(K) & "*(D" & LgTablo(K) & "-($D$" & LgTablo(K + 1) + 3 & "))*(E" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))*0.000001"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K), "R"), Cells(LgTablo(K + 1), "R"))
      .Formula = "=C" & LgTablo(K) & "*(E" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))*(F" & LgTablo(K) & "-($F$" & LgTablo(K + 1) + 3 & "))*0.000001"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K), "S"), Cells(LgTablo(K + 1), "S"))
      .Formula = "=C" & LgTablo(K) & "*(D" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))*(F" & LgTablo(K) & "-($F$" & LgTablo(K + 1) + 3 & "))*0.000001"
      .Value = .Value
    End With

' Calcul des Masses de la ligne SOUS SYSTEME
    With Range(Cells(LgTablo(K + 1) + 5, "C"), Cells(LgTablo(K + 1) + 5, "F"))
      .Formula = "=C" & LgTablo(K + 1) + 3
      .Value = .Value
    End With

'Calcul des colonnes G à S de la ligne TOTAL
    With Range(Cells(LgTablo(K + 1) + 3, "G"), Cells(LgTablo(K + 1) + 3, "S"))
      .Formula = "=SUM(G" & LgTablo(K) & ":G" & LgTablo(K + 1) & ")"
      .Value = .Value
    End With

'Calcul des colonnes G à S de la ligne SOUS SYSTEME
    With Range(Cells(LgTablo(K + 1) + 5, "G"), Cells(LgTablo(K + 1) + 5, "L"))
      .Formula = "=Sum(G" & LgTablo(K + 1) + 3 & ",N" & LgTablo(K + 1) + 3 & ")"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K + 1) + 5, "N"), Cells(LgTablo(K + 1) + 5, "S"))
      .Formula = "=Sum(G" & LgTablo(K + 1) + 5 & ",U" & LgTablo(K + 1) + 5 & ")"
      .Value = .Value
    End With
  Next K

' Inertie et Produit d'inertie totale sat
    With Range("G554:L554")
        .Formula = "=SUM(N95,N167,N186,N202,N268,N326,N362,N383,N401,N468,N495,N519,N532,N547)"
        .Value = .Value
    End With

'Calcul sous système invariant M * cood
    With Range("U556:W556")
        .Formula = "=SUM(U93,U165,U184,U200,U266,U324,U360,U381,U399,U466)"
        .Value = .Value
    End With

' Calcul Total M * coord
    With Range("U552:W552")
        .Formula = "=SUM(U493,U517,U530,U545,U556)"
        .Value = .Value
    End With

' Total masse Sat
    With Range("C554")
        .Formula = "=SUM(C95,C167,C186,C202,C268,C326,C362,C383,C401,C468,C495,C519,C532,C547)"
        .Value = .Value
    End With

' CdG Sat
    With Range("D554:F554")
        .Formula = "=U552/$C554"
        .Value = .Value
    End With

'Masse sèche
  Range("C562") = Range("C554") - Range("C547")

'Coefficient XG,YG,ZG
  Range("C558") = Range("D554").Value
  Range("C559") = Range("E554").Value
  Range("C560") = Range("F554").Value

' Calcul des colonnes U à Z (Transf. inertie Sous-Système / CdG Satellite)
  For K = 0 To UBound(LgTablo) Step 2
    With Cells(LgTablo(K + 1) + 5, "U")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*((E" & LgTablo(K + 1) + 5 & "-$C$559)^2+(F" & LgTablo(K + 1) + 5 & "-$C$560)^2)*0.000001"
      .Value = .Value
    End With
    With Cells(LgTablo(K + 1) + 5, "V")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*((D" & LgTablo(K + 1) + 5 & "-$C$558)^2+(F" & LgTablo(K + 1) + 5 & "-$C$560)^2)*0.000001"
      .Value = .Value
    End With
    With Cells(LgTablo(K + 1) + 5, "W")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*((D" & LgTablo(K + 1) + 5 & "-($C$558))^2+(E" & LgTablo(K + 1) + 5 & "-($C$559))^2)*0.000001"
      .Value = .Value
    End With
    With Cells(LgTablo(K + 1) + 5, "X")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*(D" & LgTablo(K + 1) + 5 & "-($C$558))*(E" & LgTablo(K + 1) + 5 & "-($C$559))*0.000001"
      .Value = .Value
    End With
        With Cells(LgTablo(K + 1) + 5, "Y")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*(E" & LgTablo(K + 1) + 5 & "-($C$559))*(F" & LgTablo(K + 1) + 5 & "-($C$560))*0.000001"
      .Value = .Value
    End With
    With Cells(LgTablo(K + 1) + 5, "Z")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*(D" & LgTablo(K + 1) + 5 & "-($C$558))*(F" & LgTablo(K + 1) + 5 & "-($C$560))*0.000001"
      .Value = .Value
    End With
  Next K

'============================================================================================================================================
'REPARTITION DES SOUS SYSTEME PAR PANNEAU
For K = 0 To UBound(LgTablo) Step 2
    For j = 28 To 238 Step 5
        If Cells(LgTablo(K), j) <> "" Then
            With Range(Cells(LgTablo(K), j + 1), Cells(LgTablo(K + 1), j + 1)) 'MASSE
               .Formula = "=IF(" & Cells(LgTablo(K), j).Address(rowabsolute:=False) & "=0,0,C" & LgTablo(K) & " * " & Cells(LgTablo(K), j).Address(rowabsolute:=False, columnabsolute:=False) & ")"
                .Value = .Value
            End With
            With Range(Cells(LgTablo(K), j + 2), Cells(LgTablo(K + 1), j + 2)) ' CDG X
                .Formula = "=IF(" & Cells(LgTablo(K), j).Address(rowabsolute:=False) & "=0,0,D" & LgTablo(K) & ")"
                .Value = .Value
            End With
            With Range(Cells(LgTablo(K), j + 3), Cells(LgTablo(K + 1), j + 3)) ' CDG Y
                .Formula = "=IF(" & Cells(LgTablo(K), j).Address(rowabsolute:=False) & "=0,0,E" & LgTablo(K) & ")"
                .Value = .Value
            End With
            With Range(Cells(LgTablo(K), j + 4), Cells(LgTablo(K + 1), j + 4)) 'CDG Z
                .Formula = "=IF(" & Cells(LgTablo(K), j).Address(rowabsolute:=False) & "=0,0,F" & LgTablo(K) & ")"
                .Value = .Value
            End With
        End If

        With Range(Cells(LgTablo(K), "II"), Cells(LgTablo(K + 1), "II"))
               .Formula = "=AB" & LgTablo(K) & "+ AG" & LgTablo(K) & "+ AL" & LgTablo(K) & _
            "+ AQ" & LgTablo(K) & "+ AV" & LgTablo(K) & "+ BA" & LgTablo(K) & "+ BF" & LgTablo(K) & _
            "+ BK" & LgTablo(K) & "+ BP" & LgTablo(K) & "+ BU" & LgTablo(K) & "+ BZ" & LgTablo(K) & _
            "+ CE" & LgTablo(K) & "+ CJ" & LgTablo(K) & "+ CO" & LgTablo(K) & "+ CT" & LgTablo(K) & _
            "+ CY" & LgTablo(K) & "+ DD" & LgTablo(K) & "+ DI" & LgTablo(K) & "+ DN" & LgTablo(K) & _
            "+ DS" & LgTablo(K) & "+ DX" & LgTablo(K) & "+ EC" & LgTablo(K) & "+ EH" & LgTablo(K) & _
            "+ EM" & LgTablo(K) & "+ ER" & LgTablo(K) & "+ EW" & LgTablo(K) & "+ FB" & LgTablo(K) & _
            "+ FG" & LgTablo(K) & "+ FL" & LgTablo(K) & "+ FQ" & LgTablo(K) & "+ FV" & LgTablo(K) & _
            "+ GA" & LgTablo(K) & "+ GF" & LgTablo(K) & "+ GK" & LgTablo(K) & "+ GP" & LgTablo(K) & _
            "+ GU" & LgTablo(K) & "+ GZ" & LgTablo(K) & "+ HE" & LgTablo(K) & "+ HJ" & LgTablo(K) & _
            "+ HO" & LgTablo(K) & "+ HT" & LgTablo(K) & "+ HY" & LgTablo(K) & "+ ID" & LgTablo(K)
            .Value = .Value
        End With

        Set plageA = Range(Cells(8, j + 1), Cells(543, j + 1))
        Set plageB = Range(Cells(8, j + 2), Cells(543, j + 2))
        Set plageC = Range(Cells(8, j + 3), Cells(543, j + 3))
        Set plageD = Range(Cells(8, j + 4), Cells(543, j + 4))
        A1 = Application.Sum(plageA)
        A2 = Application.SumProduct(plageA, plageB)
        A3 = Application.SumProduct(plageA, plageC)
        A4 = Application.SumProduct(plageA, plageD)
        Cells(545, j + 1) = A1

        If A1 <> 0 Then
            Cells(545, j + 2) = A2 / A1
            Cells(545, j + 3) = A3 / A1
            Cells(545, j + 4) = A4 / A1
        Else
            Cells(545, j + 2) = 0
            Cells(545, j + 3) = 0
            Cells(545, j + 4) = 0

        End If
    Next j
Next K

  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub
Le 28/06/2013 à 10:25

Bonjour,

Essaies d'ajouter en début du code

Application.Calculation = xlCalculationManual

et en fin

Application.Calculation = xlCalculationAutomatic
Le 28/06/2013 à 10:46

Merci!

Peux-tu m'expliquer à quoi servent ces lignes de code, stp?

Le 28/06/2013 à 10:56

Re,

Cette propriété renvoie ou définit une valeur XlCalculation qui représente le mode de calcul.

xlCalculationAutomatic : Excel contrôle le recalcul.

xlCalculationManual : Le calcul est effectué sur demande de l'utilisateur.

xlCalculationSemiautomatic : Excel contrôle le recalcul, mais ignore des modifications apportées aux tableaux.

Au début du code on met le mode de calcul en manuel, pour éviter les calculs qui ralentissent l'exécution de la procédure.

A la fin, on remet le mode de calcul en automatique...

Le 28/06/2013 à 11:22

Merci beaucoup pour ta réponse!

A bientôt

Le 28/06/2013 à 11:32
Option Explicit
                                 '++++++++++++++++++++++++++++++++++++++++++'
                                '+          FEUILLE MCI LAUNCH            +'
                                '++++++++++++++++++++++++++++++++++++++++++'

 Re,
A tester et me dire si tu as un gain de temps dans l'exécution de la procédure :D                                 
Private Sub Worksheet_Change(ByVal Target As Range)

'=========================================================================================================
'DECLARATION DES VARIABLES
Dim calcState As Integer, eventsState As Boolean, screenUpdateState As Boolean, statusBarState As Boolean
Dim K As Double
Dim LgTablo()
Dim i As Double, j As Long
Dim plageA As Range, plageB As Range, plageC As Range, plageD As Range
Dim A1 As Double, A2 As Double, A3 As Double, A4 As Double

'=========================================================================================================
'FONCTIONS D'OPTIMISATION
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    calcState = Application.Calculation
    eventsState = Application.EnableEvents

    With Application
        .Calculation = xlCalculationManual 'Désactive les calculs
        .DisplayStatusBar = False 'Désactive l'affichage de la barre d'état
        .EnableEvents = False ' Désactive Evenement
        .ScreenUpdating = False ' Empeche la maj de l'écran
    End With
'=========================================================================================================
On Error GoTo gestion_erreur

'Création du tableau avec le début et la fin de chaque sous ensemble
LgTablo = Array(8, 90, 104, 162, 174, 181, 193, 197, 209, 263, 275, 321, 333, 357, 369, 378, 390, 396, 408, 463, 475, 490, 502, 514, 526, 527, 539, 542)

' Travail sur les colonnes C à Z
For K = 0 To UBound(LgTablo) Step 2

' Calcul des Masses de la ligne TOTAL
   Cells(LgTablo(K + 1) + 3, "C") = Application.Sum(Range("C" & LgTablo(K) & ":C" & LgTablo(K + 1)))

' Calcul des colonnes U à W
   With Range(Cells(LgTablo(K), "U"), Cells(LgTablo(K + 1), "W"))
      .Formula = "=$C" & LgTablo(K) & "*D" & LgTablo(K)
      .Value = .Value
    End With

' Calcul des masses * coordonnées de la ligne TOTAL
   With Range(Cells(LgTablo(K + 1) + 3, "U"), Cells(LgTablo(K + 1) + 3, "W"))
      .Formula = "=SUM(U" & LgTablo(K) & ":U" & LgTablo(K + 1) & ")"
      .Value = .Value
    End With

' Calcul des CdG pour la ligne TOTAL
   With Range(Cells(LgTablo(K + 1) + 3, "D"), Cells(LgTablo(K + 1) + 3, "F"))
      .Formula = "=U" & LgTablo(K + 1) + 3 & "/$C" & LgTablo(K + 1) + 3
      .Value = .Value
    End With

'Calcul des Inerties de transports (colonne N à P)
   With Range(Cells(LgTablo(K), "N"), Cells(LgTablo(K + 1), "N"))
      .Formula = "=C" & LgTablo(K) & "*((E" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))^2+(F" & LgTablo(K) & "-($F$" & LgTablo(K + 1) + 3 & "))^2)*0.000001"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K), "O"), Cells(LgTablo(K + 1), "O"))
      .Formula = "=C" & LgTablo(K) & "*((D" & LgTablo(K) & "-($D$" & LgTablo(K + 1) + 3 & "))^2+(F" & LgTablo(K) & "-($F$" & LgTablo(K + 1) + 3 & "))^2)*0.000001"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K), "P"), Cells(LgTablo(K + 1), "P"))
      .Formula = "=C" & LgTablo(K) & "*((D" & LgTablo(K) & "-($D$" & LgTablo(K + 1) + 3 & "))^2+(E" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))^2)*0.000001"
      .Value = .Value
    End With

'Calcul des produits d'inertie de transport (colonne Q à S)
   With Range(Cells(LgTablo(K), "Q"), Cells(LgTablo(K + 1), "Q"))
      .Formula = "=C" & LgTablo(K) & "*(D" & LgTablo(K) & "-($D$" & LgTablo(K + 1) + 3 & "))*(E" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))*0.000001"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K), "R"), Cells(LgTablo(K + 1), "R"))
      .Formula = "=C" & LgTablo(K) & "*(E" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))*(F" & LgTablo(K) & "-($F$" & LgTablo(K + 1) + 3 & "))*0.000001"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K), "S"), Cells(LgTablo(K + 1), "S"))
      .Formula = "=C" & LgTablo(K) & "*(D" & LgTablo(K) & "-($E$" & LgTablo(K + 1) + 3 & "))*(F" & LgTablo(K) & "-($F$" & LgTablo(K + 1) + 3 & "))*0.000001"
      .Value = .Value
    End With

' Calcul des Masses de la ligne SOUS SYSTEME
   With Range(Cells(LgTablo(K + 1) + 5, "C"), Cells(LgTablo(K + 1) + 5, "F"))
      .Formula = "=C" & LgTablo(K + 1) + 3
      .Value = .Value
    End With

'Calcul des colonnes G à S de la ligne TOTAL
   With Range(Cells(LgTablo(K + 1) + 3, "G"), Cells(LgTablo(K + 1) + 3, "S"))
      .Formula = "=SUM(G" & LgTablo(K) & ":G" & LgTablo(K + 1) & ")"
      .Value = .Value
    End With

'Calcul des colonnes G à S de la ligne SOUS SYSTEME
   With Range(Cells(LgTablo(K + 1) + 5, "G"), Cells(LgTablo(K + 1) + 5, "L"))
      .Formula = "=Sum(G" & LgTablo(K + 1) + 3 & ",N" & LgTablo(K + 1) + 3 & ")"
      .Value = .Value
    End With
    With Range(Cells(LgTablo(K + 1) + 5, "N"), Cells(LgTablo(K + 1) + 5, "S"))
      .Formula = "=Sum(G" & LgTablo(K + 1) + 5 & ",U" & LgTablo(K + 1) + 5 & ")"
      .Value = .Value
    End With
  Next K

' Inertie et Produit d'inertie totale sat
   With Range("G554:L554")
        .Formula = "=SUM(N95,N167,N186,N202,N268,N326,N362,N383,N401,N468,N495,N519,N532,N547)"
        .Value = .Value
    End With

'Calcul sous système invariant M * cood
   With Range("U556:W556")
        .Formula = "=SUM(U93,U165,U184,U200,U266,U324,U360,U381,U399,U466)"
        .Value = .Value
    End With

' Calcul Total M * coord
   With Range("U552:W552")
        .Formula = "=SUM(U493,U517,U530,U545,U556)"
        .Value = .Value
    End With

' Total masse Sat
   With Range("C554")
        .Formula = "=SUM(C95,C167,C186,C202,C268,C326,C362,C383,C401,C468,C495,C519,C532,C547)"
        .Value = .Value
    End With

' CdG Sat
   With Range("D554:F554")
        .Formula = "=U552/$C554"
        .Value = .Value
    End With

'Masse sèche
 Range("C562") = Range("C554") - Range("C547")

'Coefficient XG,YG,ZG
 Range("C558") = Range("D554").Value
  Range("C559") = Range("E554").Value
  Range("C560") = Range("F554").Value

' Calcul des colonnes U à Z (Transf. inertie Sous-Système / CdG Satellite)
 For K = 0 To UBound(LgTablo) Step 2
    With Cells(LgTablo(K + 1) + 5, "U")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*((E" & LgTablo(K + 1) + 5 & "-$C$559)^2+(F" & LgTablo(K + 1) + 5 & "-$C$560)^2)*0.000001"
      .Value = .Value
    End With
    With Cells(LgTablo(K + 1) + 5, "V")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*((D" & LgTablo(K + 1) + 5 & "-$C$558)^2+(F" & LgTablo(K + 1) + 5 & "-$C$560)^2)*0.000001"
      .Value = .Value
    End With
    With Cells(LgTablo(K + 1) + 5, "W")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*((D" & LgTablo(K + 1) + 5 & "-($C$558))^2+(E" & LgTablo(K + 1) + 5 & "-($C$559))^2)*0.000001"
      .Value = .Value
    End With
    With Cells(LgTablo(K + 1) + 5, "X")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*(D" & LgTablo(K + 1) + 5 & "-($C$558))*(E" & LgTablo(K + 1) + 5 & "-($C$559))*0.000001"
      .Value = .Value
    End With
        With Cells(LgTablo(K + 1) + 5, "Y")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*(E" & LgTablo(K + 1) + 5 & "-($C$559))*(F" & LgTablo(K + 1) + 5 & "-($C$560))*0.000001"
      .Value = .Value
    End With
    With Cells(LgTablo(K + 1) + 5, "Z")
      .Formula = "=C" & LgTablo(K + 1) + 5 & "*(D" & LgTablo(K + 1) + 5 & "-($C$558))*(F" & LgTablo(K + 1) + 5 & "-($C$560))*0.000001"
      .Value = .Value
    End With
  Next K

'============================================================================================================================================
'REPARTITION DES SOUS SYSTEME PAR PANNEAU
For K = 0 To UBound(LgTablo) Step 2
    For j = 28 To 238 Step 5
        If Cells(LgTablo(K), j) <> "" Then
            With Range(Cells(LgTablo(K), j + 1), Cells(LgTablo(K + 1), j + 1)) 'MASSE
              .Formula = "=IF(" & Cells(LgTablo(K), j).Address(rowabsolute:=False) & "=0,0,C" & LgTablo(K) & " * " & Cells(LgTablo(K), j).Address(rowabsolute:=False, columnabsolute:=False) & ")"
                .Value = .Value
            End With
            With Range(Cells(LgTablo(K), j + 2), Cells(LgTablo(K + 1), j + 2)) ' CDG X
               .Formula = "=IF(" & Cells(LgTablo(K), j).Address(rowabsolute:=False) & "=0,0,D" & LgTablo(K) & ")"
                .Value = .Value
            End With
            With Range(Cells(LgTablo(K), j + 3), Cells(LgTablo(K + 1), j + 3)) ' CDG Y
               .Formula = "=IF(" & Cells(LgTablo(K), j).Address(rowabsolute:=False) & "=0,0,E" & LgTablo(K) & ")"
                .Value = .Value
            End With
            With Range(Cells(LgTablo(K), j + 4), Cells(LgTablo(K + 1), j + 4)) 'CDG Z
               .Formula = "=IF(" & Cells(LgTablo(K), j).Address(rowabsolute:=False) & "=0,0,F" & LgTablo(K) & ")"
                .Value = .Value
            End With
        End If

        With Range(Cells(LgTablo(K), "II"), Cells(LgTablo(K + 1), "II"))
               .Formula = "=AB" & LgTablo(K) & "+ AG" & LgTablo(K) & "+ AL" & LgTablo(K) & _
            "+ AQ" & LgTablo(K) & "+ AV" & LgTablo(K) & "+ BA" & LgTablo(K) & "+ BF" & LgTablo(K) & _
            "+ BK" & LgTablo(K) & "+ BP" & LgTablo(K) & "+ BU" & LgTablo(K) & "+ BZ" & LgTablo(K) & _
            "+ CE" & LgTablo(K) & "+ CJ" & LgTablo(K) & "+ CO" & LgTablo(K) & "+ CT" & LgTablo(K) & _
            "+ CY" & LgTablo(K) & "+ DD" & LgTablo(K) & "+ DI" & LgTablo(K) & "+ DN" & LgTablo(K) & _
            "+ DS" & LgTablo(K) & "+ DX" & LgTablo(K) & "+ EC" & LgTablo(K) & "+ EH" & LgTablo(K) & _
            "+ EM" & LgTablo(K) & "+ ER" & LgTablo(K) & "+ EW" & LgTablo(K) & "+ FB" & LgTablo(K) & _
            "+ FG" & LgTablo(K) & "+ FL" & LgTablo(K) & "+ FQ" & LgTablo(K) & "+ FV" & LgTablo(K) & _
            "+ GA" & LgTablo(K) & "+ GF" & LgTablo(K) & "+ GK" & LgTablo(K) & "+ GP" & LgTablo(K) & _
            "+ GU" & LgTablo(K) & "+ GZ" & LgTablo(K) & "+ HE" & LgTablo(K) & "+ HJ" & LgTablo(K) & _
            "+ HO" & LgTablo(K) & "+ HT" & LgTablo(K) & "+ HY" & LgTablo(K) & "+ ID" & LgTablo(K)
            .Value = .Value
        End With

        Set plageA = Range(Cells(8, j + 1), Cells(543, j + 1))
        Set plageB = Range(Cells(8, j + 2), Cells(543, j + 2))
        Set plageC = Range(Cells(8, j + 3), Cells(543, j + 3))
        Set plageD = Range(Cells(8, j + 4), Cells(543, j + 4))
        A1 = Application.Sum(plageA)
        A2 = Application.SumProduct(plageA, plageB)
        A3 = Application.SumProduct(plageA, plageC)
        A4 = Application.SumProduct(plageA, plageD)
        Cells(545, j + 1) = A1

        If A1 <> 0 Then
            Cells(545, j + 2) = A2 / A1
            Cells(545, j + 3) = A3 / A1
            Cells(545, j + 4) = A4 / A1
        Else
            Cells(545, j + 2) = 0
            Cells(545, j + 3) = 0
            Cells(545, j + 4) = 0

        End If
    Next j
Next K

    With Application
        .Calculation = calcState
        .DisplayStatusBar = statusBarState
        .EnableEvents = eventsState
        .ScreenUpdating = screenUpdateState
    End With

gestion_erreur:
    With Application
        .Calculation = calcState
        .EnableEvents = eventsState
    End With

End Sub
Le 28/06/2013 à 11:39

Ca équivaut à la solution que tu m'as donnée précisement!

Le 28/06/2013 à 11:50

Re,

Pas tout à fait et j'ai mis une gestion d'erreur pour Calculation et EnableEvents en cas de plantage de la macro.

Les modifications sont :

Dim calcState As Integer, eventsState As Boolean, screenUpdateState As Boolean, statusBarState As Boolean
'=========================================================================================================
'FONCTIONS D'OPTIMISATION
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    calcState = Application.Calculation
    eventsState = Application.EnableEvents

    With Application
        .Calculation = xlCalculationManual 'Désactive les calculs
        .DisplayStatusBar = False 'Désactive l'affichage de la barre d'état
        .EnableEvents = False ' Désactive Evenement
        .ScreenUpdating = False ' Empeche la maj de l'écran
    End With
'=========================================================================================================
On Error GoTo gestion_erreur

Et en fin de macro :

    With Application
        .Calculation = calcState
        .DisplayStatusBar = statusBarState
        .EnableEvents = eventsState
        .ScreenUpdating = screenUpdateState
    End With

gestion_erreur:
    With Application
        .Calculation = calcState
        .EnableEvents = eventsState
    End With

End Sub
Rechercher des sujets similaires à "fonction sommeprod vba"