Discussion :

[colapsus]

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 :

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
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 ?

[turbo_sophie]

voici ce que je te propose, après la création de tes différents onglets

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
 
 
Sub RemplirOnglet()
 
    Dim i As Integer, iLigne As Integer, iPassage As Integer, iColonne As Integer, iLigneEcrire As Integer
    Dim sFeuille As String, sMatricule As String
    Dim dHeure As Date, dDate As Date
    Dim sBadgeuse() As String
    Dim oFeuille As Worksheet
 
    sFeuille = "Feuil1"
    Set oFeuille = ThisWorkbook.Worksheets(sFeuille)
    oFeuille.Select
    iLigne = oFeuille.Range("A1").End(xlDown).Row
    ReDim sBadgeuse(iLigne, 4)
 
    For i = 1 To iLigne
        sBadgeuse(i - 1, 0) = oFeuille.Cells(i, 1).Value
        sBadgeuse(i - 1, 1) = oFeuille.Cells(i, 2).Value
        sBadgeuse(i - 1, 2) = oFeuille.Cells(i, 3).Value
        sBadgeuse(i - 1, 3) = oFeuille.Cells(i, 4).Value
    Next i
 
    iLigneEcrire = 12
 
    For i = 1 To iLigne
        iPassage = sBadgeuse(i - 1, 0)
        dDate = sBadgeuse(i - 1, 1)
        dHeure = sBadgeuse(i - 1, 2)
        sMatricule = sBadgeuse(i - 1, 3)
 
        On Error Resume Next
        ThisWorkbook.Worksheets(sMatricule).Select
 
 
        If ThisWorkbook.Worksheets(sMatricule).Cells(37, 1).End(xlUp).Value <> dDate Then
            iLigneEcrire = ThisWorkbook.Worksheets(sMatricule).Cells(37, 1).End(xlUp).Row + 1
        End If
 
        Select Case iPassage
            Case 0
                iColonne = 2 'B
            Case 1
                iColonne = 3
            Case 2
                iColonne = 4
            Case 3
                iColonne = 5
        End Select
        ThisWorkbook.Worksheets(sMatricule).Cells(iLigneEcrire, 1).Value = dDate
        ThisWorkbook.Worksheets(sMatricule).Cells(iLigneEcrire, iColonne).Value = dHeure
        ThisWorkbook.Worksheets(sMatricule).Cells(iLigneEcrire, iColonne).NumberFormatLocal = "hh:mm:ss"
    Next i
 
End Sub