Addition de cellules sous VBA

Le 09/09/2019 à 15:25

Bonjour le forum,

Petite question :

J'aimerais faire le total de toutes les lignes de F24 à F88 et faire apparaître ce résultat directement dans la cellule colonne F de la ligne "Total Amount In €" sous forme VBA et surtout l'incorporer à ce code :

Private Sub CommandButton3_Click()
Dim c As Range
Dim rng As Range
Dim last As Long
Dim soustotal As Double

soustotal = 0
last = Application.WorksheetFunction.Max(31, Sheets("PROPOSAL").Cells(Rows.Count, "A").End(xlUp).Row) + 1
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set rng = Range("D9:D100")
    For Each c In rng
        If (Sheets("List Bank").Range("C" & c.Row).Value <> 0) Then
            Sheets("PROPOSAL").Range("A" & last).Value = Sheets("List Bank").Range("C" & c.Row).Value

            If (Sheets("List Bank").Range("D" & c.Row).Value <> 0) Then
                Sheets("PROPOSAL").Range("D" & last).Value = Sheets("List Bank").Range("D" & c.Row).Value
Sheets("PROPOSAL").Range("E" & last).Value = "1"
soutotal = soustotal + Sheets("PROPOSAL").Range("D" & last).Value
            End If

            last = last + 1

        End If
    Next c

Sheets("PROPOSAL").Range("A" & last).Value = "Total Amount In €"
Sheets("PROPOSAL").Range("F" & last).Value = soustotal

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox " All Copies have been performed ... "
End Sub

Si quelqu'un a une piste, je suis preneuse

Nat,

Le 10/09/2019 à 12:04

Bonjour,

de ma compréhension, la maro telle quelle aurait pour but de copier des éléments de la feuille list bank dans la feuille proposal et de faire la somme de la colonne D et mettre cette somme en dernière ligne de la colonne F.

la macro actuelle contient une erreur dans la ligne et ce code ne donne donc pas le résultat attendu.

soutotal=soustotal+ ...

en imaginant que le total de la colonne D doive aller en colonne D et qu'il faille ajouter un nouveau total de la colonne F en colonne F, voici une correction du code

Private Sub CommandButton3_Click()
    Dim c As Range
    Dim rng As Range
    Dim last As Long
    Dim soustotal As Double

    soustotalD = 0
    soustotalF = 0
    last = Application.WorksheetFunction.Max(31, Sheets("PROPOSAL").Cells(Rows.Count, "A").End(xlUp).Row) + 1
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set rng = Range("D9:D100")
    For Each c In rng
        If (Sheets("List Bank").Range("C" & c.Row).Value <> 0) Then
            Sheets("PROPOSAL").Range("A" & last).Value = Sheets("List Bank").Range("C" & c.Row).Value

            If (Sheets("List Bank").Range("D" & c.Row).Value <> 0) Then
                Sheets("PROPOSAL").Range("D" & last).Value = Sheets("List Bank").Range("D" & c.Row).Value
                Sheets("PROPOSAL").Range("F" & last).Value = Sheets("List Bank").Range("F" & c.Row).Value
                Sheets("PROPOSAL").Range("E" & last).Value = "1"
                soustotalD = soustotalD + Sheets("PROPOSAL").Range("D" & last).Value
                soustotalF = soustotalF + Sheets("PROPOSAL").Range("F" & last).Value
            End If

            last = last + 1

        End If
    Next c

    Sheets("PROPOSAL").Range("A" & last).Value = "Total Amount In €"
    Sheets("PROPOSAL").Range("D" & last).Value = soustotalD
    Sheets("PROPOSAL").Range("F" & last).Value = soustotalF

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox " All Copies have been performed ... "
End Sub

l'inconvénient avec ta demande, c'est qu'il faut deviner ce qu'il faut faire, c'est pourquoi on demande de toujours fournir un fichier.

Le 10/09/2019 à 17:08
h2so4 a écrit :

Bonjour,

de ma compréhension, la maro telle quelle aurait pour but de copier des éléments de la feuille list bank dans la feuille proposal et de faire la somme de la colonne D et mettre cette somme en dernière ligne de la colonne F.

la macro actuelle contient une erreur dans la ligne et ce code ne donne donc pas le résultat attendu.

soutotal=soustotal+ ...

en imaginant que le total de la colonne D doive aller en colonne D et qu'il faille ajouter un nouveau total de la colonne F en colonne F, voici une correction du code

Private Sub CommandButton3_Click()
    Dim c As Range
    Dim rng As Range
    Dim last As Long
    Dim soustotal As Double

    soustotalD = 0
    soustotalF = 0
    last = Application.WorksheetFunction.Max(31, Sheets("PROPOSAL").Cells(Rows.Count, "A").End(xlUp).Row) + 1
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set rng = Range("D9:D100")
    For Each c In rng
        If (Sheets("List Bank").Range("C" & c.Row).Value <> 0) Then
            Sheets("PROPOSAL").Range("A" & last).Value = Sheets("List Bank").Range("C" & c.Row).Value

            If (Sheets("List Bank").Range("D" & c.Row).Value <> 0) Then
                Sheets("PROPOSAL").Range("D" & last).Value = Sheets("List Bank").Range("D" & c.Row).Value
                Sheets("PROPOSAL").Range("F" & last).Value = Sheets("List Bank").Range("F" & c.Row).Value
                Sheets("PROPOSAL").Range("E" & last).Value = "1"
                soustotalD = soustotalD + Sheets("PROPOSAL").Range("D" & last).Value
                soustotalF = soustotalF + Sheets("PROPOSAL").Range("F" & last).Value
            End If

            last = last + 1

        End If
    Next c

    Sheets("PROPOSAL").Range("A" & last).Value = "Total Amount In €"
    Sheets("PROPOSAL").Range("D" & last).Value = soustotalD
    Sheets("PROPOSAL").Range("F" & last).Value = soustotalF

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox " All Copies have been performed ... "
End Sub

l'inconvénient avec ta demande, c'est qu'il faut deviner ce qu'il faut faire, c'est pourquoi on demande de toujours fournir un fichier.

Bonjour H2so4,

Je viens de lire ton message tardivement... Entre temps j'ai solutionné mon problème par le code suivant :

Private Sub CommandButton3_Click()
Dim c As Range
Dim rng As Range
Dim last As Long
Dim soustotal As Double
Dim total As Double

soustotal = 0
total = 0
last = Application.WorksheetFunction.Max(31, Sheets("PROPOSAL").Cells(Rows.Count, "A").End(xlUp).Row) + 1
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set rng = Range("D9:D100")
    For Each c In rng
        If (Sheets("List Bank").Range("C" & c.Row).Value <> 0) Then
            Sheets("PROPOSAL").Range("A" & last).Value = Sheets("List Bank").Range("C" & c.Row).Value

              If (Sheets("List Bank").Range("D" & c.Row).Value <> 0) Then
                Sheets("PROPOSAL").Range("D" & last).Value = Sheets("List Bank").Range("D" & c.Row).Value
                Sheets("PROPOSAL").Range("E" & last).Value = "1"
                Sheets("PROPOSAL").Range("F" & last).Value = Sheets("PROPOSAL").Range("D" & last).Value
                soustotal = soustotal + Sheets("PROPOSAL").Range("D" & last).Value
            End If

            last = last + 1

        End If

    Next c
Sheets("PROPOSAL").Range("A" & last).Value = "Sub Total Bank"
Sheets("PROPOSAL").Range("F" & last).Value = soustotal

last = last + 1

'ajouter la ligne "total"
Sheets("PROPOSAL").Range("A" & last).Value = "Total Amount In €"
total = total + Sheets("PROPOSAL").Range("D" & last).Value
Sheets("PROPOSAL").Range("F" & last).Value = total

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox " All Copies have been performed ... "
End Sub

Cependant je n'arrive pas à faire dire à mon code que quand dans la colonne "E" il y a le chiffre "1" alors il faut prendre la valeur en face de ce chiffre donc dans la colonne "D". Tous les additionner pour les faire apparaître dans la colonne "F" = total

capture

Nat,

Rechercher des sujets similaires à "addition vba"