export donnees depart

**tseoy** · 28/02/2015, 17h32

bonjour,
J'ai besoin de votre aide pour une macro.
Ci joint mon fichier composé de 4 onglets
sur chaque onglet la colonne A correspond au nom des agents.Cette colonne A comprend en haut les IDE et en deuxieme moitié les AS (deux catégories differentes).
Ensuite il y a douze colonnes de janvier à decembre. Dans ces colonnes des temps de travail 1=100% et 0 la personne n'est plus dans le service.
Mon souhait est de pouvoir extraire les personnes qui quittent le service (passe à 0) et de les positionner sur l'onglet "départ" par mois.
(mais qu'ils n'apparaissent qu'une fois sur cet onglet le mois ou il passe à 0)
La seule séparation sur l'onglet depart est les IDE et AS (je n'ai pas besoin des étages)
merci de votre aide
tableau des effectifs 2015test.xlsx

**gnain** · 28/02/2015, 19h22

Bonjour,

Je vous donne le code pour la première feuille,
il suffit de s'inspirer de ce code pour faire le reste.
Le nom des variable parle par eux même.

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
Sub test()
 
Dim Ligne_commence_IDE As Integer
Dim Ligne_fin_IDE As Integer
Dim Ligne_commence_AS As Integer
Dim Ligne_depart_IDE As Integer
Dim Ligne_depart_AS As Integer
 
Worksheets("depart").Select
 
Range("C4:N500").Select
Selection.ClearContents
Range("A1").Select
 
Worksheets("Secteur A1").Select
 
'==================================================
'on récupere la premiere ligne IDE
For Ligne_commence_IDE = 1 To 5000
    If Cells(Ligne_commence_IDE, 1).Value = "IDE" Then
        Ligne_commence_IDE = Ligne_commence_IDE + 1
        Exit For
    End If
Next
'==================================================
 
 
 
'==================================================
'on récupere la premiere ligne AS
For Ligne_commence_AS = 1 To 5000
    If Cells(Ligne_commence_AS, 1).Value = "AS" Or Cells(Ligne_commence_AS, 1).Value = "AS A1" Then
        Ligne_commence_AS = Ligne_commence_AS + 1
        Ligne_fin_IDE = Ligne_commence_AS - 2
        Exit For
    End If
Next
'=================================================
 
 
For i = 7 To 18
 
    Ligne_depart_IDE = 4
 
    For IDE = Ligne_commence_IDE To Ligne_fin_IDE
        If Worksheets("depart").Cells(Ligne_depart_IDE, i - 4).Value <> Cells(IDE, 1).Value Then
            If Cells(IDE, i).Value = "0" Then
                Worksheets("depart").Cells(Ligne_depart_IDE, i - 4).Value = Cells(IDE, 1).Value
                Ligne_depart_IDE = Ligne_depart_IDE + 1
            End If
        End If
    Next
 
    Ligne_depart_AS = 17
 
    For AS_ = Ligne_commence_AS To 500
 
        If Worksheets("depart").Cells(Ligne_depart_AS, i - 4).Value <> Cells(AS_, 1).Value Then
            If Cells(AS_, i).Value = "0" Then
                Worksheets("depart").Cells(Ligne_depart_AS, i - 4).Value = Cells(AS_, 1).Value
                Ligne_depart_AS = Ligne_depart_AS + 1
            End If
        End If
    Next
 
Next
 
MsgBox "Fin"
 
End Sub

**tseoy** · 28/02/2015, 21h00

Merci
cela correspond a ce que je cherchais.
Par contre, y a t il moyen pour que le nom de la personne qui tombe à 0 soit inscrit sur un seul mois, le mois de son départ.
ici par exemple le nom se repete sur tous les mois
bonne soiree
tableau des effectifs 2015test.xlsx

**gnain** · 28/02/2015, 22h53

Il faut garder les nom en mémoire puis passer une boucle pour voir si il est déjà utilisé
dans ce nouveau code j'utilise directement excel pour garder en mémoire colonne O et P

Je vous donne le code pour la première feuille,
il suffit de s'inspirer de ce code pour faire le reste.
Le nom des variable parle par eux même.

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
108
109
Sub test()
 
Dim Ligne_commence_IDE As Integer
Dim Ligne_fin_IDE As Integer
Dim Ligne_commence_AS As Integer
Dim Ligne_depart_IDE As Integer
Dim Ligne_depart_AS As Integer
Dim Tableau_IDE() As String
Dim Tableau_AS() As String
Dim Ligne_Temp_IDE As Integer
Dim Ligne_Temp_AS As Integer
Dim on_Ajoute_IDE As Boolean
Dim on_Ajoute_AS As Boolean
 
Worksheets("depart").Select
 
Range("C4:N500").Select
Selection.ClearContents
 
 
Columns("O:P").Select
Selection.ClearContents
Range("A1").Select
 
Worksheets("Secteur A1").Select
 
'==================================================
'on récupere la premiere ligne IDE
For Ligne_commence_IDE = 1 To 5000
    If Cells(Ligne_commence_IDE, 1).Value = "IDE" Then
        Ligne_commence_IDE = Ligne_commence_IDE + 1
        Exit For
    End If
Next
'==================================================
 
 
 
'==================================================
'on récupere la premiere ligne AS
For Ligne_commence_AS = 1 To 5000
    If Cells(Ligne_commence_AS, 1).Value = "AS" Or Cells(Ligne_commence_AS, 1).Value = "AS A1" Then
        Ligne_commence_AS = Ligne_commence_AS + 1
        Ligne_fin_IDE = Ligne_commence_AS - 2
        Exit For
    End If
Next
'=================================================
 
on_Ajoute_IDE = True
 
For i = 7 To 18
 
    Ligne_depart_IDE = 4
 
    For IDE = Ligne_commence_IDE To Ligne_fin_IDE
        If Worksheets("depart").Cells(Ligne_depart_IDE, i - 4).Value <> Cells(IDE, 1).Value Then
            If Cells(IDE, i).Value = "0" Then
                For Ligne_Temp_IDE = 1 To Worksheets("depart").Range("O" & Rows.Count).End(xlUp).Offset(1, 0).Row - 1
                    If Cells(IDE, 1).Value = Worksheets("depart").Cells(Ligne_Temp_IDE, 15).Value Then
                        on_Ajoute_IDE = False
                        Exit For
                    Else
                        on_Ajoute_IDE = True
                    End If
                Next
                If on_Ajoute_IDE = True Then
                    Worksheets("depart").Cells(Ligne_depart_IDE, i - 4).Value = Cells(IDE, 1).Value
                    Worksheets("depart").Cells(Ligne_Temp_IDE, 15).Value = Cells(IDE, 1).Value
                    Ligne_depart_IDE = Ligne_depart_IDE + 1
                End If
            End If
        End If
    Next
 
    Ligne_depart_AS = 17
 
    For AS_ = Ligne_commence_AS To 500
 
        If Worksheets("depart").Cells(Ligne_depart_AS, i - 4).Value <> Cells(AS_, 1).Value Then
            If Cells(AS_, i).Value = "0" Then
                For Ligne_Temp_AS = 1 To Worksheets("depart").Range("P" & Rows.Count).End(xlUp).Offset(1, 0).Row - 1
                    If Cells(AS_, 1).Value = Worksheets("depart").Cells(Ligne_Temp_AS, 16).Value Then
                        on_Ajoute_AS = False
                        Exit For
                    Else
                        on_Ajoute_AS = True
                    End If
                Next
                If on_Ajoute_AS = True Then
                    Worksheets("depart").Cells(Ligne_depart_AS, i - 4).Value = Cells(AS_, 1).Value
                    Worksheets("depart").Cells(Ligne_Temp_AS, 16).Value = Cells(AS_, 1).Value
                    Ligne_depart_AS = Ligne_depart_AS + 1
                End If
            End If
        End If
    Next
 
Next
 
Worksheets("depart").Select
 
Columns("O:P").Select
Selection.ClearContents
Range("A1").Select
 
MsgBox "Fin"
 
End Sub

Ne pas oublier de mettre en Résolu et de voté si cela vous convient

**tseoy** · 28/02/2015, 23h18

merci beaucoup

export donnees depart [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager