Somme de plusieurs colonnes en fonction d'un critère

Le 05/11/2020 à 14:56

Bonjour à tous,

Je suis encore novice en macro et je souhaiterais simplifier mes formules.

Voici mon problème, j'ai fait comme vous pouvez le voir plus bas des additions de plusieurs colonnes pour plusieurs cellules. Cela marche très bien néanmoins l'ergonomie de la macro n'est pas la meilleure.

Ma question est la suivante:

- Comment simplifier la chose afin de faire des sommes de plages entière ?

Sub Inscription_FS()

Dim Matrice As String
Dim Fichier As String
Dim rep As String
Dim centre As String
Dim i As Long

Dim test As Boolean

Application.ScreenUpdating = False

Matrice = ActiveWorkbook.Name

rep = Rep_Source.CheminSce.Value & "\"

Fichier = Dir(rep)
Do While Fichier <> ""

    test = False

    If Left(Fichier, 7) = "Recueil" Then

        Workbooks.Open rep & Fichier

        centre = Sheets("Accueil").Range("B6").Value

        i = 3

        'Nettoyage de l'onglet
        Sheets("Siège Coordination").Visible = True
        Sheets("Siège Coordination").Select
        Range("C2:C12").ClearContents

        'Remplissage
        Do While Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("D" & i).Value <> "" And test = False
            If Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("D" & i).Value = centre Then

        Range("C2").Value = Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("R" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("S" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("T" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("U" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("V" & i).Value   'DSIN

        Range("C3").Value = Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("N" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("O" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("P" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("Q" & i).Value     'DMGIA

        Range("C4").Value = Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("W" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("X" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("Y" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("Z" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("AA" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("AB" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("AC" & i).Value  'RH

        Range("C5").Value = Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("F" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("G" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("H" & i).Value      'TP

        Range("C6").Value = Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("I" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("J" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("K" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("L" & i).Value + Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("M" & i).Value    'Compta

            End If
            i = i + 1
        Loop

        Application.DisplayAlerts = False
        Workbooks(Fichier).Save
        Workbooks(Fichier).Close
        Application.DisplayAlerts = True

    End If

    Fichier = Dir
Loop

Application.ScreenUpdating = True

MsgBox "Fini !"

End Sub

Merci de votre aide

Bonne journée.

Le 05/11/2020 à 18:30

Salut,

Pas de fichier = pas de réponse

On peut voir ton fichier de base et un fichier "Recueil", s'il-te-plait ?

Amicalement.

Le 06/11/2020 à 08:53

Bonjour Yvouille,

Voici les fichiers :

Je n'ai mis qu'un fichier recueil parce que ils ont tous la même architecture. En ce qui concerne le fichier fs-projet c'est lui qui contient la macro.

Cordialement,

7recueil-bp2021.xlsx (92.06 Ko)
7fs-projet.zip (370.90 Ko)
Le 06/11/2020 à 17:26

Salut,

Si j'ai bien compris, ton seul problème est un problème de ''gueule'' de ta macro.

Je te montre alors des modifications possibles afin d'alléger ton code, sans rien y changer à son déroulement. Je présume qu'il serait possible d'aller encore un peu plus loin.

Je ne me suis occupé que de la macro "Inscription_FS", mais d'autres de tes codes pourraient être modifiés selon les mêmes principes.

Sub Inscription_FS()

Dim Fichier As String
Dim rep As String
Dim centre As String
Dim i As Long
Dim deb As Long
Dim fin As Long

Application.ScreenUpdating = False

rep = Rep_Source.CheminSce & "\"

Fichier = Dir(rep)
Do While Fichier <> ""

    If LCase(Left(Fichier, 7)) = "recueil" Then

        Workbooks.Open rep & Fichier

        centre = Sheets("Accueil").Range("B6")

        i = 3

        'Nettoyage de l'onglet FS/FF
        Sheets("Siège Coordination").Visible = True
        Sheets("Siège Coordination").Select
        Range("C2:C12").ClearContents

        'Remplissage des FS/FF
        With ThisWorkbook.Sheets("Synthèse Ctre Sce 2021")
            Do While .Range("D" & i) <> "" 
                If .Range("D" & i) = centre Then

                Range("C2") = .Range("W" & i) + .Range("X" & i) + .Range("Y" & i) + .Range("Z" & i) + .Range("AA" & i) 'DSIN
                Range("C3") = .Range("Q" & i) + .Range("R" & i) + .Range("S" & i) + .Range("T" & i)  'DMGIA
                Range("C4") = .Range("AB" & i) + .Range("AC" & i) + .Range("AD" & i) + .Range("AE" & i) + .Range("AF" & i) + .Range("AG" & i) + .Range("AH" & i) 'RH
                Range("C5") = .Range("I" & i) + .Range("J" & i) + .Range("K" & i)    'TP
                Range("C6") = .Range("L" & i) + .Range("M" & i) + .Range("N" & i) + .Range("O" & i) + .Range("P" & i) 'Compta
                Range("C7") = .Range("U" & i) + .Range("V" & i)      'CDG
                Range("C8") = .Range("H" & i)        'CODIR
                Range("C9") = .Range("AI" & i)        'MED TRA
                Range("C10") = .Range("AJ" & i)       'MARK
                Range("C11") = .Range("AK" & i) + .Range("AL" & i)     'QUAL
                Range("C12") = "CAH/FAM/SAVS"            'COORD
                End If
                i = i + 1

            Loop
        End With

    Application.DisplayAlerts = False
    Workbooks(Fichier).Save
    Workbooks(Fichier).Close
    Application.DisplayAlerts = True

    End If

    Fichier = Dir
Loop

MsgBox "Fini !"

End Sub

Dans le fichier, j'ai placé pas mal de commentaires.

Amicalement.

7fs-projet-v1.zip (365.84 Ko)

EDIT : J'AI POSTE UN PEU VITE ! IL Y A BIEN ENTENDU UNE AUTRE SIMPLIFICATION QUE JE PEUX ENCORE TE MONTRER. JE REVIENS D'ICI 20 MINUTES

Le 06/11/2020 à 17:50

Enfin, presque 20 minutes

Voici la manière de simplifier les totaux :

                Range("C2") = WorksheetFunction.Sum(.Range("W" & i & ":AA" & i)) 'DSIN
                Range("C3") = WorksheetFunction.Sum(.Range("Q" & i & ":T" & i))   'DMGIA
                Range("C4") = WorksheetFunction.Sum(.Range("AB" & i & ":AH" & i))   'RH
                Range("C5") = WorksheetFunction.Sum(.Range("I" & i & ":K" & i))     'TP
                Range("C6") = WorksheetFunction.Sum(.Range("L" & i & ":P" & i))   'Compta
                Range("C7") = WorksheetFunction.Sum(.Range("U" & i & ":V" & i))    'CDG
                Range("C8") = .Range("H" & i)    'CODIR
                Range("C9") = .Range("AI" & i)   'MED TRA
                Range("C10") = .Range("AJ" & i)  'MARK
                Range("C11") = WorksheetFunction.Sum(.Range("AK" & i & ":AL" & i)) 'QUAL
                Range("C12") = "CAH/FAM/SAVS"    'COORD
8fs-projet-v2.zip (366.83 Ko)

Lorsqu'il n'y a que deux colonnes à additionner, on aurait pu garder ta manière, avec le signe +, ce qui serait presque plus simple.

Le 06/11/2020 à 17:52

Salut,

En effet le problème était tout d'abord un problème d'allègement du code.

Mais maintenant j'ai un autre problème, un collègue a fait un autre fichier fs-projet est maintenant quand j'utilise la macro "Inscription_FS" j'ai une erreur d'incompatibilité de type. Alors que pour moi les deux fichiers sont identiques.

Je joins le nouveau fichier ci-dessous (ce fichier ne contient pas encore les modifications que tu as apporté ci-dessus).

7ventilation-fs-projet-v2.zip (220.96 Ko)
Le 06/11/2020 à 17:54

Je trouve qu'un tout petit commentaire positif sur le travail déjà exécuté m'encouragerait à voir ton prochain problème.

Le 06/11/2020 à 19:17

En effet je n'avais pas vu ton second message il a dû arriver au moment où je postais le mien.

Je te remercie énormément c'est vrai que ça va me permettre d'avoir une macro plus aérée et plus facile à lire.

Je vois que tu as utilisé "WorksheetFunction.Sum(.Range("W" & i & ":AA" & i))".
Pour ma part j'avais essayé sans succès "Application.WorksheetFunction.Sum(Workbooks(Matrice).Sheets("Synthèse Ctre Sce 2021").Range("R:S" & i))", je devais surement mal m'y prendre et faire des erreurs de "syntaxe".

Encore merci pour ton aide. En espérant que mon prochain problème soit aussi facile à résoudre pour toi.

Le 06/11/2020 à 21:27

Salut,

Tu n'as même pas regardé les deux fichiers que je t'ai fourni ; ils ont toujours leur compteur sur zéro !

Ton nouveau fichier ne comporte pas les améliorations que tu m'as demandées !!!

Je te laisse te débrouiller avec ton nouveau problème.

Le 07/11/2020 à 12:44

Bonjour Yvouille,

C'est vrai que c'est un manque de respect de ma part de ne pas avoir regardé ton fichier alors que tu y as passé du temps dessus.

Ce matin j'ai eu un peu plus de temps pour le regarder et faire les modifications de "ma" v2 avec les lignes de codes simplifiées que tu avais mise dans le second fichier que tu as envoyé.

J'avais une petite question concernant celui-ci si tu souhaites y répondre.
La ligne LCase c'est bien pour passer "Recueil" en "recueil" ? Si oui, mes fichiers sont bien avec une majuscule au début mais quand je les mets sur le forum une minuscule apparaît.

Sinon j'ai retenté la macro suite aux changements que tu m'as proposé et je n'ai plus eu de message d'erreur sur l'incompatibilité de type. En espérant que cela marche aussi quand je testerai avec les fichiers que j'ai au boulot.

Encore merci pour ton aide.
Bonne journée.

Le 07/11/2020 à 14:03

Excuses acceptées.

Comme je l'ai indiqué en commentaire dans le code, LCase c'est bien pour passer "Recueil" en "recueil".

Reviens à la charge ici si ça ne passe pas au boulot.

Bonne fin de semaine.

Rechercher des sujets similaires à "somme colonnes fonction critere"