Créer une feuille de calcul a partir d'autre avec macros

  • Initiateur de la discussion Initiateur de la discussion TSniper
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

T

TSniper

Guest
Bonjour,
J'ai un classeur qui contient les informatios sur un projet.
Chaque employé passe un certains temps à travayer dessus dans des dates différentes en collaborations avec tout le groupe.
je veux créer une nouvelle feuille qui calcul le temps total du travail d'un employer dans tout les projet.
tout ça avec un macro
je suis la pour plus d'explications
Merci
 

Pièces jointes

Dernière modification par un modérateur:
Re : Créer une feuille de calcul a partir d'autre avec macros

Bonjour TSniper,

Bienvenue sur XLD,

peut-être, en D8 de la feuille Total

Code:
=SOMME.SI(Feuil1!$B$31:$B$39;Total!C8;Feuil1!$E$31:$E$39)+SOMME.SI(Feuil2!$B$31:$B$39;Total!C8;Feuil2!$E$31:$E$39)+SOMME.SI(Feuil3!$B$31:$B$39;Total!C8;Feuil3!$E$31:$E$39)

Edit : Oups, j'avais pas lu "avec macros"...
 
Dernière édition:
Re : Créer une feuille de calcul a partir d'autre avec macros

Bonjour TSniper,

Bienvenue sur XLD,

peut-être, en D8 de la feuille Total

Code:
=SOMME.SI(Feuil1!$B$31:$B$39;Total!C8;Feuil1!$E$31:$E$39)+SOMME.SI(Feuil2!$B$31:$B$39;Total!C8;Feuil2!$E$31:$E$39)+SOMME.SI(Feuil3!$B$31:$B$39;Total!C8;Feuil3!$E$31:$E$39)

Edit : Oups, j'avais pas lu "avec macros"...

Merci commemêm pour l'effort j'espère que je trouve d'autres idée pour ce MACRO
 
Re : Créer une feuille de calcul a partir d'autre avec macros

Re,

un essai

Code:
Option Explicit

Sub CalcTotal()
Dim i As Long, j As Long, k As Long, Dico, Somme() As Double, Elt As Variant
    Set Dico = CreateObject("Scripting.Dictionary")
    ReDim Somme(1 To 1)
    With Sheets("Total")
        .Range("C8:D65536").ClearContents
        For i = 1 To 3 'Feuilles Feuil1 à Feuil3
            j = 31 'Ligne de début des données sur chaque feuille
            Do Until Sheets("Feuil" & i).Cells(j, 2).Value = ""
                Dico(Sheets("Feuil" & i).Cells(j, 2).Value) = 1
                If Dico.Count > UBound(Somme) Then
                    ReDim Preserve Somme(1 To UBound(Somme) + 1)
                    Somme(UBound(Somme)) = CDbl(Sheets("Feuil" & i).Cells(j, 5).Value)
                Else
                    Elt = Dico.keys
                    For k = LBound(Elt) To UBound(Elt)
                        If Elt(k) = Sheets("Feuil" & i).Cells(j, 2).Value Then
                            Somme(k + 1) = Somme(k + 1) + CDbl(Sheets("Feuil" & i).Cells(j, 5).Value)
                            Exit For
                        End If
                    Next k
                End If
                j = j + 1
            Loop
        Next i
        'Ecriture résultats
        Elt = Dico.keys
        For i = LBound(Elt) To UBound(Elt)
            .Range("C" & i + 8).Value = Elt(i)
            .Range("D" & i + 8).Value = Somme(i + 1)
        Next i
    End With
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

R
Réponses
14
Affichages
623
RobinSAH
R
Retour