Ajouter des lignes manqante
Bonjour bonjour à tous, voici mon probleme, au tout départ j'ai une liste de valeurs tel que celle ci :
0 18/05/2011 07:30 4127
2 18/05/2011 07:30 4127
3 18/05/2011 12:00 4144
0 18/05/2011 13:02 4127
1 18/05/2011 18:10 4144
2 18/05/2011 07:34 4127
3 18/05/2011 12:05 4144
0 18/05/2011 13:02 4127
1 18/05/2011 17:04 4145
2 18/05/2011 13:59 4127
3 18/05/2011 18:18 4145
0 18/05/2011 08:55 4149
1 18/05/2011 12:05 4149
2 18/05/2011 13:02 4149
3 18/05/2011 14:11 4149
0 18/05/2011 07:52 4149
1 18/05/2011 12:44 4149
2 18/05/2011 13:40 4149
3 18/05/2011 17:11 4149
0 18/05/2011 08:39 4149
1 18/05/2011 12:05 4149
2 18/05/2011 13:02 4149
3 18/05/2011 16:44 4149
0 18/05/2011 16:12 4149
1 18/05/2011 19:29 4149
2 18/05/2011 13:18 4149
qui répertorie les entrées et sorties des employés, tel que
0 = entrée 1
1 = sortie 1
2 = entrée 2
3 = sortie 2
avec ensuite la date, l'heure et le matricule
Malheureusement, certaines personnes oublient de passer et d'indiquer une entrée ou une sortie ce qui sur une journée au lieu de faire 0 1 2 3 on aurait 0 2 3 ou des choses comme cela, ainsi je cherche comment ajouter ces entrées manquantes, c'est a dire que sur 3 lignes ou on aurait
0
1
3
hop une nouvelle ligne s'ajoute entre 1 et 3 pour faire :
0
1
2
3
J'avais d'abord pensé à ce code
Sub oubli()
Dim i As Integer
Dim x As Integer
x = 0
i = 1
While i < 25
If Cells(i + 1, 1).Value - Cells(i, 1).Value <> 1 Then
Cells(i + 1, 1).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 1).Select
Selection.Copy
Cells(i + 2, 1).Select
ActiveSheet.Paste
Cells(i + 2, 1).Value = Cells(i, 1) + 1
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Cells(i + 2, 2).Select
ActiveSheet.Paste
Cells(i, 4).Select
Application.CutCopyMode = False
Selection.Copy
Cells(i + 2, 4).Select
ActiveSheet.Paste
End If
i = i + 1
Wend
End SubMais il ne semble pas fonctionner, quelqu'un aurait une idée à me proposer ?
P.S : ce sujet a été écrit pour faciliter le probleme d'un sujet précédent.
-- 30 Juin 2011, 11:28 --
ya t'il quelqu'un sur le forum ?
-- 30 Juin 2011, 12:46 --
Fonctionne enfin grace à :
Sub oubli()
Dim i As Long
For i = 1 To 500
If Cells(i, 1).Value = "" Then Exit Sub
If Cells(i, 1).Value <> (i - 1) Mod 4 Then
Rows(i).Copy: Rows(i).Insert xlShiftDown
Cells(i, 1).Value = (i - 1) Mod 4
Cells(i, 3).Value = ""
Cells(i, 2).Value = Cells(i - 1, 2).Value
End If
Next i
End Sub