Regroupement de tâches

Bonjour,

Je suis un peu novice en la matière, c'est pour cela que je viens ici pour un peu d'aide.

Alors mon problème est celui ci :

J'ai un calendrier d'un mois (Janvier par ex.), un employé doit remplir dans celui-ci, l'étude ou les études qu'il a fait pour chaque jour du mois.

Jour 1..........................//.......Jour 2

Etude0001....0.5.......//........Etude0002....1

Etude0002....0.5

Etc...

Il me faudrait rechercher juste toutes les " Etude* " du tableau en gardant la valeur de la colonne d'à coté qui est (0.25, 0.5, 0.75 ou 1) correspondant au temps passé.

Et si elles sont identiques, aditionner cette valeur.

Le but est de savoir combien de temps une étude x a été traité au cours du mois.

Et ensuite il y aura un regroupements de x fichiers (personnes) pour voir en tout combien de temps l'étude a été traité, mais ca sera après.

Voilà, je cherche toujours de mon coté !

Merci d'avance

Bonsoir,

Afin de répondre au mieux, il serait préférable que tu joignes un fichier exemple, avec la structure exacte de ton fichier, et des données anonymisées.

Bon courage

Oui c'est vrai que c'est plus parlant.

C'est ajouté !

Bonsoir,

Regarde le fichier joint.

Tu appuies sur le bouton bleu, et les données s'inscrivent dans la "Feuil2"

Bonne soirée

Merci !! Ca m'aide beaucoup !

Maintenant je cherche à l'inclure dans mon fichier principale mais j'ai une erreur 1004 à cette ligne :

"For Each Cel In Plg.SpecialCells(xlCellTypeConstants, 7)"

Sub Extraction()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String

With Sheets("Feuil1")
    .Cells.Clear
End With

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    fichier = Dir(Chemin & "*.xls")
    With Sheets("Feuil1")
        .[A1] = fichier
    End With

    Do While Len(fichier) > 0
        If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$D$8:$R$36"
            With Sheets("Feuil2")
                .[D8:R36] = "=Plage"
                Call Etudes
'                .[D8:R36].Copy
'                Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End With
        End If

        fichier = Dir()
        With Sheets("Feuil1")
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = fichier
        End With
    Loop
End If
'With Sheets("Feuil2")
'    .[D8:R36].Clear
'End With
End Sub

Sub Etudes()
Dim Cel As Range, Champ As Range
Dim Etude As Object

Set Etude = CreateObject("Scripting.Dictionary")
Set Champ = Sheets("Feuil2").Range("D8:R36" & Sheets("Feuil2").Cells(Rows.Count, "A").End(xlUp).Row + 3)
For Each Cel In Champ.SpecialCells(xlCellTypeConstants, 7)
    If Cel.Value Like "Etude*" Then
        Etude(Cel.Value) = Etude(Cel.Value) + Cel.Offset(, 1).Value
    End If
Next Cel
With Sheets("Feuil1")
'    .Cells.Clear
    .Range("A1") = "Etudes": .Range("B1") = "Durée"
    .Range("A2").Resize(Etude.Count) = Application.Transpose(Etude.Keys)
    .Range("B2").Resize(Etude.Count) = Application.Transpose(Etudes.Items)
End With
End Sub

Bonjour,

Effectivement, comme tu remplis ta zone "Champ" par des formules, le code ne va pas trouver de constantes....

Donc les SpecialCells ne sont plus xlCellTypeConstants, mais xlCellTypeFormulas..

Remplace ton code par celui-ci :

Sub Etudes()
Dim Cel As Range, Champ As Range
Dim Etude As Object

Set Etude = CreateObject("Scripting.Dictionary")
Set Champ = Sheets("Feuil2").Range("D8:R" & Sheets("Feuil2").Cells(Rows.Count, "D").End(xlUp).Row + 3)
For Each Cel In Champ.SpecialCells(xlCellTypeFormulas, 7)
    If Cel.Value Like "Etude*" Then
        Etude(Cel.Value) = Etude(Cel.Value) + Cel.Offset(, 1).Value
    End If
Next Cel
With Sheets("Feuil1")
    '    .Cells.Clear
    .Range("A1") = "Etudes": .Range("B1") = "Durée"
    .Range("A2").Resize(Etude.Count) = Application.Transpose(Etude.Keys)
    .Range("B2").Resize(Etude.Count) = Application.Transpose(Etude.Items)
End With
End Sub

PS : Attention, quand tu recopies le code (le plus simple, tu cliques sur "Sélectionner Tout")

Dans ta recopie, 2 erreurs :

Le calcul de la dernière cellule remplie (il faut se référencer à la colonne D)

Et tu avais mis Etudes (avec un "s") dans l'antépénultième ligne...;

Bon W-E

Ha merci c'est ce que je cherchais..

Oui les erreurs ne sont pas dans mon code, c'est juste en changeant le texte pour le forum.

Merci beaucoup !!!