Discussion :

[Clemzor]

Bonjour à tous,

N'étant pas un pro en programmation excel je viens ici pour demander votre aide et surtout savoir si ce que je souhaite est réalisable et comment ? (Je me rends bien compte que j'en demande beaucoup...)

Je souhaiterais tout d'abord savoir si il est possible de créer une macro permettant d'affecter sur différents fichiers excel des dossiers à chaque collaborateur de mon service, (le nombre d'affectation pourrait être indiqué dans un fichier excel annexe reprenant les initiales de chaque collaborateur avec le nombre de dossier à lui attribuer) en indiquant les initiales du collaborateurs en question sur la dernière colonne de chaque dossier qui lui aura été affecté et en colorant la ligne d'une couleur prédéterminée.

Ceci permettrait d'automatiser le dispatching des dossiers à mon boulot et de ne pas perdre plusieurs heures par semaine à le faire manuellement.

Bien sur l'affectation dépendrait de plusieurs variables que je vous indiquerais (à l'appui de fichier excel test si vous le souhaitez).

Je vous remercie de votre aide,
Excellente soirée à toutes et à tous.

[Daniel.C]

Bonjour,

C'est possible sous réserve de ce qui n'est pas précisé. Le seul point qui pourrait poser problème est l'utilisation d'initiales. Tu risques de retrouver avec des doublons. Maintenant si tu donnais un exemple concret avec des variables que tu indiquerais tout de suite, on pourrait te répondre plus facilement.

[Clemzor]

Bonjour et merci pour votre réponse.

Je vous joint un fichier exemple.
Il faudrait dans la macro définir le mois qui nous intéresse sur le fichier, ici par exemple du 01/08 au 31/08/2013 (colonne H) et que pour chaque collaborateur j'indique le nombre de dossier à lui affecter dans un fichier annexe.

Etant donné, que dans l'ordre il faudrait d'abord affecter les RD : D3 D4 et D11 puis ensuite affecter par ordre d'échéance, c'est à dire 01/08, 02/08, 03/08 etc..., sachant que du moment où la colonne J est renseignée, le dossier est considéré comme traité et ne doit pas être affecté.

Le but étant d'insérer de manière automatique les initiales du collaborateur dans la W en suivant la logique d'affectation ci dessus.

Nous pourrions nous servir du dossier mis en pièce jointe, pour que la macro aille chercher combien de dossier affecter à chaque collaborateur pour chaque ville.

Par exemple, indiquer 10 dans la colonne Besancon pour le collaborateur LM. Ce qui reviendrait à affecter dix dossiers à LM sur le fichier Besançon en respectant le fait de d'abord affecter les RD : D3/D4/D11 du mois M concerné et dès qu'il n'y a plus ces RD affecter par ordre chronologique.

Dans la macro il faudrait indiquer qu'il faut d'abord affecter les RD : D3/D4/D11 puis dès qu'il n'y en a plus par ordre chronologique du mois M.

J'espère avoir répondu à vos questions.

[mercatog]

L'ordre des collaborateur doit être aléatoire ou toujours commencer par le premier (dans ton cas LM ensuite EJ...)

Edit [Proposition]

1. Je suppose qu' une date quelconque valide du mois à traiter est entrée en B3.
2. Je suppose que l'ordre des collaborateurs est respecté (On traite d'abord LM, ensuite le restant pour EJ...).
3. Je suppose que les fichiers des sites se trouvent dans le même répertoire.

Code à mettre dans un module standard du fichier suivi affect hebdo

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Option Explicit
 
Sub Dispatcher()
Dim LastCol As Integer, N As Integer, m As Integer
Dim DD As Long, DF As Long, ND As Long, NF As Long
Dim LastLig As Long, i As Long, j As Long
Dim Fichier As String, Collab As String
Dim Wbk As Workbook
Dim Dte As Date
Dim Data, Tb
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("S18")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    Data = .Range("A5").Resize(LastLig - 4, LastCol)
    Dte = CDate(.Range("B3").Value)
    DD = DateSerial(Year(Dte), Month(Dte), 1)
    DF = DateAdd("d", -1, DateAdd("m", 1, Dte))
End With
 
For m = 3 To LastCol
    Fichier = ThisWorkbook.Path & "\" & Data(1, m) & ".xlsx"
    If OuvrirFichier(Wbk, Fichier) Then
        With Wbk.Worksheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
            Tb = .Range("A3:W" & LastLig)
 
            For j = 1 To UBound(Tb, 1)
                If CLng(Tb(j, 8)) >= DD And ND = 0 Then ND = j
                If CLng(Tb(j, 8)) > DF Then
                    NF = j - 1
                    Exit For
                End If
            Next j
            If ND <> 0 Then
                If NF = 0 Then NF = j
                For i = 2 To UBound(Data, 1)
                    N = Val(Data(i, m))
                    If N > 0 Then
                        Collab = Data(i, 1)
                        Remp Tb, N, Collab, ND, NF, "D3"
                        If N > 0 Then Remp Tb, N, Collab, ND, NF, "D4"
                        If N > 0 Then Remp Tb, N, Collab, ND, NF, "D11"
                        If N > 0 Then Remp Tb, N, Collab, ND, NF, "", True
                    End If
                Next i
                .Range("A3:W" & LastLig) = Tb
            End If
        End With
 
        Wbk.Close True
        Set Wbk = Nothing
    Else
        MsgBox "Fichier " & Fichier & " inexistant", , "Erreur Fatale"
    End If
    ND = 0: NF = 0
Next m
MsgBox "Traitement terminé..."
End Sub
 
Private Function OuvrirFichier(ByRef Wbk As Workbook, ByVal NomFichier As String) As Boolean
 
If Dir(NomFichier) <> "" Then
    Set Wbk = Workbooks.Open(NomFichier)
    OuvrirFichier = True
End If
End Function
 
Private Sub Remp(ByRef Tb, ByRef NN As Integer, ByVal Collabo As String, ByVal D As Long, ByVal F As Long, ByVal Rd As String, Optional Chrono As Boolean = False)
Dim p As Long
 
For p = D To F
    If Tb(p, 10) = "" And Tb(p, 23) = "" Then
        If Tb(p, 7) = Rd Or Chrono Then
            Tb(p, 23) = Collabo
            NN = NN - 1
            If NN = 0 Then Exit For
        End If
    End If
Next p
End Sub

[Clemzor]

Bonsoir et merci Mercatog.

Je confirme bien que l'ordre des collaborateur n'est pas forcément obliger de respecter l'ordre indiqué dans le fichier test.

1. Concernant la case B3 en principe elle me sert à mettre la date du jour à laquelle j'affecte les dossiers aux collaborateurs

2. Oui on peut respecter l'ordre

3. Les fichiers des sites (7 au total) sont tous dans le même répertoire, y compris le fichier suivi affect hedbo

Petite question qui peut paraître bête mais pour tester ton code, quelles données dois-je modifier pour l'appliquer ?

Je vous remercie,
Bonne soirée.

[mercatog]

Il suffit de renseigner la cellule B3 par une date quelconque appartenant au mois pour lequel le dispatching est effectué.

Pour ne pas avoir des conflits avec les collaborateurs, ci-joint code modifié où l'ordre des collaborateurs est aléatoire par rapport à la liste initiale.

Mettre le code en entier dans un module standard du fichier suivi affect hebdo.xls et lance la procédure Dispatcher

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Option Explicit
 
Sub Dispatcher()
Dim LastCol As Integer, N As Integer, m As Integer
Dim DD As Long, DF As Long, ND As Long, NF As Long
Dim LastLig As Long, i As Long, j As Long
Dim Fichier As String, Collab As String
Dim Wbk As Workbook
Dim Dte As Date
Dim Data, Tb
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("S18")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    Data = .Range("A5").Resize(LastLig - 4, LastCol)
    Dte = CDate(.Range("B3").Value)
    DD = DateSerial(Year(Dte), Month(Dte), 1)
    DF = DateAdd("d", -1, DateAdd("m", 1, Dte))
End With
 
For m = 3 To LastCol
    Fichier = ThisWorkbook.Path & "\" & Data(1, m) & ".xlsx"
    If OuvrirFichier(Wbk, Fichier) Then
        With Wbk.Worksheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
            Tb = .Range("A3:W" & LastLig)
 
            For j = 1 To UBound(Tb, 1)
                If CLng(Tb(j, 8)) >= DD And ND = 0 Then ND = j
                If CLng(Tb(j, 8)) > DF Then
                    NF = j - 1
                    Exit For
                End If
            Next j
 
            If ND <> 0 Then
                If NF = 0 Then NF = j - 1
                AleaTab Data
                For i = 2 To UBound(Data, 1)
                    N = Val(Data(i, m))
                    If N > 0 Then
                        Collab = Data(i, 1)
                        Remp Tb, N, Collab, ND, NF, "D3"
                        If N > 0 Then Remp Tb, N, Collab, ND, NF, "D4"
                        If N > 0 Then Remp Tb, N, Collab, ND, NF, "D11"
                        If N > 0 Then Remp Tb, N, Collab, ND, NF
                    End If
                Next i
                .Range("A3:W" & LastLig) = Tb
            End If
        End With
 
        Wbk.Close True
        Set Wbk = Nothing
        ND = 0: NF = 0
    Else
        MsgBox "Fichier " & Fichier & " inexistant", , "Erreur Fatale"
    End If
Next m
MsgBox "Traitement terminé..."
End Sub
 
Private Function OuvrirFichier(ByRef Wbk As Workbook, ByVal NomFichier As String) As Boolean
 
If Dir(NomFichier) <> "" Then
    Set Wbk = Workbooks.Open(NomFichier)
    OuvrirFichier = True
End If
End Function
 
Private Sub Remp(ByRef Tb, ByRef NN As Integer, ByVal Collabo As String, ByVal D As Long, ByVal F As Long, Optional ByVal Rd As String = vbNullString)
Dim p As Long
 
For p = D To F
    If Tb(p, 10) = "" And Tb(p, 23) = "" Then
        If Tb(p, 7) = Rd Or Rd = vbNullString Then
            Tb(p, 23) = Collabo
            NN = NN - 1
            If NN = 0 Then Exit For
        End If
    End If
Next p
End Sub
 
Private Sub AleaTab(ByRef Tablo)
Dim i As Long, j As Long, q As Long
Dim k As Integer
Dim Tmp
 
q = UBound(Tablo, 1)
For i = 2 To q - 1
    Randomize
    j = Int((q - i + 1) * Rnd + i)
    If j <> i Then
        For k = 1 To UBound(Tablo, 2)
            Tmp = Tablo(i, k)
            Tablo(i, k) = Tablo(j, k)
            Tablo(j, k) = Tmp
        Next k
    End If
Next i
End Sub

[Clemzor]

Merci !

Ça m'a l'air de fonctionner l'ordre d'affectation étant bien respecté.
Toutefois pour l'un des fichiers excel, j'ai une erreur lors du lancement de la macro "Erreur d'execution 6 : dépassement de capacité".

Penses tu qu'il soit également possible de pouvoir imprimer directement la liste de chaque collaborateur de manière automatique? En filtrant la colonne J par "vide" et la colonne "W" par chaque collaborateur ?

[mercatog]

Il faudra d'abord connaître l'origine de l'erreur et quel est la particularité du fichier en question.

Un Integer qu'il faudrait déclarer en Long?

[Clemzor]

Le fichier est le suivant strasbourg.xls

Pourtant il me semble être identique aux autres, concernant les Integer même en les changeant en Long l'erreur à l'air de subsister.

[mercatog]

J'ai ôté le format date de la colonne libellé, l'erreur est évitée.

Sinon, une autre version utilisant 2 petits tableaux au lieux d'un grand tableau (et sans toucher au format de la colonne libellé)

Sinon, la feuille est protégée (le code la déprotège et la re-protège)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Option Explicit
 
Sub Dispatcher()
Dim LastCol As Integer, N As Integer, m As Integer
Dim DD As Long, DF As Long, ND As Long, NF As Long
Dim LastLig As Long, i As Long, j As Long
Dim Fichier As String, Collab As String
Dim Wbk As Workbook
Dim Dte As Date
Dim Data, Tb, Res
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("S18")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
    Data = .Range("A5").Resize(LastLig - 4, LastCol)
    Dte = CDate(.Range("B3").Value)
    DD = DateSerial(Year(Dte), Month(Dte), 1)
    DF = DateAdd("d", -1, DateAdd("m", 1, Dte))
End With
 
For m = 3 To LastCol
    Fichier = ThisWorkbook.Path & "\" & Data(1, m) & ".xlsx"
    If OuvrirFichier(Wbk, Fichier) Then
        With Wbk.Worksheets(1)
            LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
            Tb = .Range("G3:J" & LastLig)
 
            For j = 1 To UBound(Tb, 1)
                If CLng(Tb(j, 2)) >= DD And ND = 0 Then ND = j
                If CLng(Tb(j, 2)) > DF Then
                    NF = j - 1
                    Exit For
                End If
            Next j
 
             Res = .Range("W3:W" & LastLig)
 
            If ND <> 0 Then
                If NF = 0 Then NF = j - 1
                AleaTab Data
                For i = 2 To UBound(Data, 1)
                    N = Val(Data(i, m))
                    If N > 0 Then
                        Collab = Data(i, 1)
                        Remp Tb, Res, N, Collab, ND, NF, "D3"
                        If N > 0 Then Remp Tb, Res, N, Collab, ND, NF, "D4"
                        If N > 0 Then Remp Tb, Res, N, Collab, ND, NF, "D11"
                        If N > 0 Then Remp Tb, Res, N, Collab, ND, NF
                    End If
                Next i
                .Unprotect
                .Range("W3:W" & LastLig) = Res
                .Protect
            End If
        End With
 
        Wbk.Close True
        Set Wbk = Nothing
        ND = 0: NF = 0
    Else
        MsgBox "Fichier " & Fichier & " inexistant", , "Erreur Fatale"
    End If
Next m
MsgBox "Traitement terminé..."
End Sub
 
Private Function OuvrirFichier(ByRef Wbk As Workbook, ByVal NomFichier As String) As Boolean
 
If Dir(NomFichier) <> "" Then
    Set Wbk = Workbooks.Open(NomFichier)
    OuvrirFichier = True
End If
End Function
 
Private Sub Remp(ByVal Tb, ByRef Res, ByRef NN As Integer, ByVal Collabo As String, ByVal D As Long, ByVal F As Long, Optional ByVal Rd As String = vbNullString)
Dim p As Long
 
For p = D To F
    If Tb(p, 4) = "" And Res(p, 1) = "" Then
        If Tb(p, 1) = Rd Or Rd = vbNullString Then
            Res(p, 1) = Collabo
            NN = NN - 1
            If NN = 0 Then Exit For
        End If
    End If
Next p
End Sub
 
Private Sub AleaTab(ByRef Tablo)
Dim i As Long, j As Long, q As Long
Dim k As Integer
Dim Tmp
 
q = UBound(Tablo, 1)
For i = 2 To q - 1
    Randomize
    j = Int((q - i + 1) * Rnd + i)
    If j <> i Then
        For k = 1 To UBound(Tablo, 2)
            Tmp = Tablo(i, k)
            Tablo(i, k) = Tablo(j, k)
            Tablo(j, k) = Tmp
        Next k
    End If
Next i
End Sub

[Clemzor]

Bonjour et merci pour votre aide.

Concernant la macro est il normal que si j'affecte a un collaborateur plusieurs dossiers dans différentes villes seule une des villes est renseignée de ses initiales?

Est il possible d'imprimer automatiquement la liste pour chaque collaborateur? En filtrant la colonne W et la colonne J en "vide"

Bonne journée

[mercatog]

Concernant la macro est il normal que si j'affecte a un collaborateur plusieurs dossiers dans différentes villes seule une des villes est renseignée de ses initiales?

Faux

[Clemzor]

Faux

Merci Mercatog pour ton travail.

Toutefois, le fichier a quelques peu été modifiés, les villes sont maintenant toutes sur un même classeur (triées par onglets) et la colonne a incrémenter des initiales et désormais la colonne R sachant que si T est renseigné le dossier n'est plus attribué.

Penses tu qu'il est compliqué de modifier ta macro pour l'adapter au nouveau fichier ?

Si oui, laisse tomber tu en as déjà pas mal fait pour moi. Si non, je te joindrais en PJ le nouveau fichier.

Je te remercie,
Bonne fin de journée.

[mercatog]

Non, ce n'est pas compliqué et je pense même que si tu as compris la démarche, tu pourra t'en sortir. Par contre si tu t'es contenté d'un copier/coller à l'aveuglette, tu auras des soucis.

Encore, le projet est ton travail et non le mien, c'est à dire tu vois d'où les efforts doivent émaner.

[Clemzor]

Je comprends le point de vue.

J'avoue que n'ayant que peu de bases en VBA (j'essaye de bidouiller des macro déjà existantes la plupart du temps) j'ai du mal à déchiffrer et comprendre le raisonnement de chaque module.

Ici dans le tien je comprends le tout début mais j'avoue qu'après je m'y perds vraiment et certaines fonctions me sont même totalement inconnues.

Comme tu le dis c'est mon projet, toutefois je savais dès le départ que sans l'aide des forumeurs c'était un projet mort né, car je suis totalement incapable de réaliser de moi même le quart des choses que vous pouvez expliquer.

Je te mets quand même en PJ le fichier avec le nouveau formalisme si jamais tu veux y jeter un oeil.

Comme indiqué précédemment, les initiales sont en "R", et si la colonne "T" est renseignée le dossier n'est plus à attribuer. La colonne "L" correspondant au RD de l'ancien fichier.
Le fichier de suivi affect hebdo restant lui inchangé.

Dans tous les cas, merci.