1 pièce(s) jointe(s)
Excel, VBA, onglet et copier coller
Bonjour à tous forumeurs et forumeuses comment allez vous en ce début d'apres midi ?
Voila, je demande votre aide, pour m'aider à résoudre un sacré probleme pas piqué des hanetons ^^
Cela se passe sur une badgeuse, dont le programme a pour but de traiter les données, imaginez au départ j'ai ceci :
Entrée Date heure Matricule
0 mercredi 1 juin 2011 08:46 4037
1 mercredi 1 juin 2011 12:28 4037
2 mercredi 1 juin 2011 13:34 4037
3 mercredi 1 juin 2011 17:31 4037
0 mercredi 1 juin 2011 07:10 4127
1 mercredi 1 juin 2011 12:20 4127
2 mercredi 1 juin 2011 13:14 4127
3 mercredi 1 juin 2011 16:44 4127
0 mercredi 1 juin 2011 07:41 4128
1 mercredi 1 juin 2011 12:00 4128
2 mercredi 1 juin 2011 13:55 4128
3 mercredi 1 juin 2011 17:04 4128
1 mercredi 1 juin 2011 13:56 4149
0 mercredi 1 juin 2011 13:56 4149
1 mercredi 1 juin 2011 18:04 4149
0 mercredi 1 juin 2011 08:49 4150
1 mercredi 1 juin 2011 12:03 4150
2 mercredi 1 juin 2011 13:14 4150
3 mercredi 1 juin 2011 17:42 4150
Editer le messageAccepter cette réponseRapporter le messageRépondre en citant le messageExcel, VBA, onglet et copier coller
de colpasus » 27 Juin 2011, 16:02
Bonjour à tous les forumeurs, j'ai un problème sur le programme que je suis en train de concevoir, cela se passe sur une badgeuse, dont le programme a pour but de traiter les données, imaginez au départ j'ai ceci :
Entrée Date heure Matricule
0 mercredi 1 juin 2011 08:46 4037
1 mercredi 1 juin 2011 12:28 4037
2 mercredi 1 juin 2011 13:34 4037
3 mercredi 1 juin 2011 17:31 4037
0 mercredi 1 juin 2011 07:10 4127
1 mercredi 1 juin 2011 12:20 4127
2 mercredi 1 juin 2011 13:14 4127
3 mercredi 1 juin 2011 16:44 4127
0 mercredi 1 juin 2011 07:41 4128
1 mercredi 1 juin 2011 12:00 4128
2 mercredi 1 juin 2011 13:55 4128
3 mercredi 1 juin 2011 17:04 4128
1 mercredi 1 juin 2011 13:56 4149
0 mercredi 1 juin 2011 13:56 4149
1 mercredi 1 juin 2011 18:04 4149
0 mercredi 1 juin 2011 08:49 4150
1 mercredi 1 juin 2011 12:03 4150
2 mercredi 1 juin 2011 13:14 4150
3 mercredi 1 juin 2011 17:42 4150
et pour chaque matricule, un onglet doit être crée, et retourner cela :
Date Entrée 1 Sortie 1 Entrée 2 Sortie 2
mercredi 1 juin 2011 12:14:00 13:12:00 17:04:00 16:15:00
lundi 6 juin 2011 12:08:00 13:09:00 17:43:00 16:12:00
mardi 7 juin 2011 08:21:00 12:18:00 13:22:00 17:41:00
mercredi 8 juin 2011 13:15:00 14:23:00 18:27:00 16:12:00
Et comme vous le voyez, tout est décalé, alors oui j'ai le code généraliste, mais je n'ai pas pris en compte le fait que certaines personnes oublieraient de passer a la badgeuse, ce qui cause un immense décalage, et pour compenser cela, je me sens perdu, donc si quelqu'un a idée voici le code :
Code:
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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
Sub matricule()
Dim NomEmployer(29) As String
Dim NumereauMatricule(29) As String
Dim K As String
Dim enplacementEmployer(29) 'je ne savais pas comment appeler la variable
NomEmployer(11) = "TOTO" ' nom employer et matricule correspondant
NumereauMatricule(11) = 4127
NomEmployer(12) = "TATA"
NumereauMatricule(12) = 4164
NomEmployer(13) = "TITI"
NumereauMatricule(13) = 4145
NomEmployer(14) = "ROMINET"
NumereauMatricule(14) = 4149
NomEmployer(15) = "CALC"
NumereauMatricule(15) = 4158
NomEmployer(16) = "DARK"
NumereauMatricule(16) = 4163
NomEmployer(17) = "VADOR"
NumereauMatricule(17) = 4171
NomEmployer(18) = "DARKE"
NumereauMatricule(18) = 4146
NomEmployer(19) = "SIDIOUS"
NumereauMatricule(19) = 4169
NomEmployer(20) = "AFIN"
NumereauMatricule(20) = 4173
NomEmployer(21) = "DE"
NumereauMatricule(21) = 4166
NomEmployer(22) = "FAIRE"
NumereauMatricule(22) = 1
NomEmployer(23) = "UN"
NumereauMatricule(23) = 4069
NomEmployer(24) = "EXEMPLE"
NumereauMatricule(24) = 4037
NomEmployer(25) = "EN"
NumereauMatricule(25) = 1247
NomEmployer(26) = "LISANT"
NumereauMatricule(26) = 4157
NomEmployer(27) = "CELA"
NumereauMatricule(27) = 4150
NomEmployer(28) = "SOYEZ"
NumereauMatricule(28) = 4128
EmployerTotal = 28 'nombre total d'employer
For i = 11 To EmployerTotal
On Error Resume Next 'création des 18 feuilles par rapport à employertotal, pour un employé une feuille de créer
Sheets(NumereauMatricule(i)).Delete
On Error GoTo 0
Sheets.Add
ActiveSheet.Name = NumereauMatricule(i) 'on correspond au nom de la page ,le matricule de l'employé
With ActiveWorkbook.Worksheets(NumereauMatricule(i))
Columns("A:A").Select
Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
Columns("G:G").ColumnWidth = 14.29
Columns("A:A").ColumnWidth = 22.86
.Range("A11").Value = "Date"
.Range("B11").Value = "entrée 1"
.Range("C11").Value = "sortie 1"
.Range("D11").Value = "entrée 2"
.Range("E11").Value = "sortie 2"
.Range("F11").Value = "Total/jour"
.Range("G11").Value = "Total/semaine"
Columns("I:I").ColumnWidth = 15.29
.Range("A1").Value = "DEVINE"
.Range("A3").Value = "LA RUE"
.Range("A5").Value = "OU"
.Range("A7").Value = NomEmployer(i)
.Range("F7").Value = "numéro de carte : " & NumereauMatricule(i)
.Range("F5").Value = "LA VILLE"
.Range("A11:G37").Select
.Range("A37").Value = "Total du mois"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
End With
Next i 'on passe au rang suivant
Dim j As Integer
Dim l As Integer
j = 12
For i = 10 To EmployerTotal
enplacementEmployer(i) = 12
Next i
matriculePressedent = "0"
While ActiveWorkbook.Worksheets("Feuil1").Cells(j, 1).Value <> "" 'tant qu'il existe une valeur dans la colonne A la boucle continue
For i = 10 To EmployerTotal
If ActiveWorkbook.Worksheets("Feuil1").Cells(j, 4).Value = NumereauMatricule(i) Then
K = NumereauMatricule(i)
m = i
End If
Next i
If matriculePressedent = K And l = 3 Then
l = 4
Else
l = 2
enplacementEmployer(MPressedent) = enplacementEmployer(MPressedent) + 1
End If
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).NumberFormatLocal = "hh:mm:ss"
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 3).Value 'on copie les cellules de la pointeuse vers la nouvelle
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), 1).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 2).Value
l = l + 1
j = j + 1
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).NumberFormatLocal = "hh:mm:ss"
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 3).Value
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), 1).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 2).Value
j = j + 1
matriculePressedent = K
MPressedent = m
Wend
End Sub |
Et pour ceux qui le déirent voici aussi le fichier joint
Et voici le fichier demandé apres avoir lancé la macro "matricule", comme vous le verrez, quand il manque une entrée, il y a un décalage sur les onglets
Et pour faire simple, quelqu'un saurait il comment éviter ce décalage ?
