Discussion :

[lourid]

Bonjour a tout le monde j’écris da l’Italie, j’espère m’exprimer bien.
Dans un fichier Excel je a joins j’ai dans la feuille 2 3 colonnes

A B C Dans la colonne A numéro d’entreprise employé dans la colonne B Date et dans la colonne C l’abréviation de l’absence avec les heures

Je voudrais utiliser le code VBA pour columnize les données comme dans la feuille 3
Dans la colonne A la matriculation et sous les dates dans la colonne C l’absence avec les heures


Je joins le fichier xlsm

[ARTURO83]

Bonjour,

Le code Vba

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
 
Sub Copiare()
    Dim DerLig_F1 As Long
    Dim f1, f2
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("Foglio2")
    Set f2 = Sheets("Foglio3")
    f2.Cells.Clear
 
    DerLig_F1 = f1.[A10000].End(xlUp).Row
    f1.Range(Cells(1, "A"), Cells(DerLig_F1, "C")).Copy Destination:=f2.Cells(1, "A")
 
    Matr = Cells(1, "A")
    For i = 2 To DerLig_F1
        If f2.Cells(i, "A") = Matr Then
            f2.Cells(i, "A") = ""
        Else
            Matr = Cells(i, "A")
        End If
    Next
 
    f2.Select
    For i = 1 To DerLig_F1
        If Cells(i, "A") <> "" Then
            Matr = Cells(i, "A")
            Rows(i).Insert Shift:=xlDown
            Cells(i, "B") = Matr
            With Cells(i, "B").Font
                .Name = "Calibri"
                .Size = 11
                .Color = -16776961
            End With
            i = i + 1
        End If
    Next
    Columns(1).Delete
End Sub

Le fichier
Pièce jointe 478989

Cdlt

[lourid]

Merci Arturo pour votre sollicitude


Il est possible d'avoir la colonne B sous A et C à côté

[ARTURO83]

Bonjour,

Je ne comprends pas, n'est-ce pas ce qui était demandé?

------Avant(Foglio2)-------------------------------------------------- Après(Foglio3)
Pièce jointe 479286 ------------- Pièce jointe 479290

Cdlt

[lourid]

Bonsoir,
exactement et ce que je voudrais mais après avoir couru la macro ça me donne ce résultat:

[lourid]

J'ai associé la macro à un bouton

[ARTURO83]

Bonjour,

Visiblement, la macro n'a pas été au bout de son cycle, remplacez le code par celui-ci

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
Sub Copiare()
    Dim DerLig_F1 As Long, i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Matr As String
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("Foglio2")
    Set f2 = Sheets("Foglio3")
    f2.Cells.Clear
 
    DerLig_F1 = f1.[A10000].End(xlUp).Row
    f1.Range(Cells(1, "A"), Cells(DerLig_F1, "C")).Copy Destination:=f2.Cells(1, "A")
 
    Matr = Cells(1, "A")
    For i = 2 To DerLig_F1
        If f2.Cells(i, "A") = Matr Then
            f2.Cells(i, "A") = ""
        Else
            Matr = Cells(i, "A")
        End If
    Next
 
    f2.Select
   For i = 1 To DerLig_F1
        If Cells(i, "A") <> "" Then
            Matr = Cells(i, "A")
            Rows(i).Insert Shift:=xlDown
            Cells(i, "B") = Matr
            With Cells(i, "B").Font
                .Name = "Calibri"
                .Size = 11
                .ColorIndex = 3
            End With
            i = i + 1
        End If
    Next
    Columns(1).Delete
End Sub

A la ligne 24 "For i = 1 To DerLig_F1" mettez un point d'arrêt , lancez la macro et à partir du point d'arrêt continuez en pas à pas(avec F8) et observez à partir de quelle ligne s'arrête la macro.

Cdlt

[lourid]

Bonsoir
J'ai inséré la macro dans un module et ça marche !!!
Je voudrais vous demander s'il est possible
entrer dans la colonne A aux dates samedis et dimanches du moi et faire un résumé des heures d'absence dans la colonne B

ou il y a RL =ROL
ou ILYA O = ORD

00FIA	000001
20190301	FE07000
20190202	R000000
20190203	R000000
20190304	O070000
20190305	O070000
20190306	O070000
20190306	RL020000
20190307	O070000
20190308	O070000
20190309	R000000
20190310	R000000
20190311	RL070000
20190312	O070000
20190313	O070000
20190314	O070000
20190315	O070000
20190316	R000000
20190317	R000000
20190318	O070000
20190319	O070000
20190320	O070000
20190321	O070000
20190322	O070000
20190323	R000000
20190324	R000000
20190325	O070000
20190326	O070000
20190327	O070000
20190328	O070000
20190329	O070000
20190330	R000000
20190331	R00000
ROL	9000
ORD	1330000
FE	7000

[ARTURO83]

Bonjour,

Conformément à ce qui a été demandé

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
Option Compare Text
 
Sub Copiare()
    Dim DerLig_F1 As Long, DerLig_F2 As Long, i As Long, j As Long, L As Long
    Dim ROL As Long, ORD As Long, FE As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Matr As String
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("Foglio2")
    Set f2 = Sheets("Foglio3")
    f2.Cells.Clear
 
    DerLig_F1 = f1.[A10000].End(xlUp).Row
    f1.Range(Cells(1, "A"), Cells(DerLig_F1, "C")).Copy Destination:=f2.Cells(1, "A")
 
    Matr = Cells(1, "A")
    For i = 2 To DerLig_F1
        If f2.Cells(i, "A") = Matr Then
            f2.Cells(i, "A") = ""
        Else
            Matr = Cells(i, "A")
        End If
    Next
 
    f2.Select
    'Formule pour récupérer le jour
    Range("D1:D" & DerLig_F1).FormulaR1C1 = "=IF(RC[-1]<>"""",DATE(LEFT(RC[-2],4),MID(RC[-2],5,2),RIGHT(RC[-2],2))*1,"""")"
    Columns("D:D").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
    For i = DerLig_F1 + 1 To 2 Step -1
        If Format(Cells(i - 1, "D"), "dddd") = "Vendredi" Then
            If Cells(i, "B") <> "" Then Rows(i & ":" & i + 1).Insert Shift:=xlDown
            Cells(i, "D") = Cells(i - 1, "D") + 1
            Cells(i, "B") = Year(Cells(i, "D")) & Format(Month(Cells(i, "D")), "00") & Format(Day(Cells(i, "D")), "00")
            Cells(i + 1, "D") = (Cells(i, "D") + 1) * 1
            Cells(i + 1, "B") = Year(Cells(i + 1, "D")) & Format(Month(Cells(i + 1, "D")), "00") & Format(Day(Cells(i + 1, "D")), "00")
            Range(Cells(i, "C"), Cells(i + 1, "C")) = "R000000"
            With Range(Cells(i, "B"), Cells(i + 1, "C")).Font
                .Name = "Calibri"
                .Size = 11
                .ColorIndex = 1
            End With
        End If
    Next i
 
    DerLig_F2 = [B10000].End(xlUp).Row
    For i = DerLig_F2 To 2 Step -1
        ROL = 0
        ORD = 0
        FE = 0
        L = i
        For j = L To 1 Step -1
            Select Case Left(Cells(L, "C"), 1)
                Case Is = "R"
                    ROL = ROL + Right(Cells(L, "C"), 6) * 1
                Case Is = "O"
                    ORD = ORD + Right(Cells(L, "C"), 6) * 1
                Case Is = "F"
                    FE = FE + Right(Cells(L, "C"), 6) * 1
                End Select
                If Cells(L, "A") <> "" Then Exit For
                L = L - 1
        Next j
        If i <> DerLig_F2 Then Rows(i + 2 & ":" & i + 4).Insert Shift:=xlDown
        If i = DerLig_F2 Then
            Cells(i + 1, "B") = "ROL"
            Cells(i + 1, "C") = ROL
            Cells(i + 2, "B") = "ORD"
            Cells(i + 2, "C") = ORD
            Cells(i + 3, "B") = "FE"
            Cells(i + 3, "C") = FE
        Else
            Cells(i + 2, "B") = "ROL"
            Cells(i + 2, "C") = ROL
            Cells(i + 3, "B") = "ORD"
            Cells(i + 3, "C") = ORD
            Cells(i + 4, "B") = "FE"
            Cells(i + 4, "C") = FE
        End If
        i = L - 1
    Next i
 
    For i = 1 To DerLig_F2
        If Cells(i, "A") <> "" Then
            Matr = Cells(i, "A")
            Rows(i).Insert Shift:=xlDown
            Cells(i, "B") = Matr
            With Cells(i, "B").Font
                .Name = "Calibri"
                .Size = 11
                .ColorIndex = 3
            End With
            i = i + 1
        End If
    Next
    Range("A:A,D:D").Delete Shift:=xlToLeft
End Sub

Avec le fichier
Pièce jointe 479797

Cdlt

[lourid]

Bonjour Arturo merci, comme toujours,
dans la macro, je ne suis pas inclus les samedis et les dimanches dans la colonne A et dans le total des heures ORD me 126 au lieu de 133?

[ARTURO83]

Bonjour,

dans la macro, je ne suis pas inclus les samedis et les dimanches dans la colonne A Désolé, je ne comprends pas le sens de votre phrase

dans le total des heures ORD me 126 au lieu de 133 N'obtenez-vous pas le résultat affiché ci-dessous?
Pièce jointe 480022

Tout ceci n'est-il pas conforme à votre dernière demande? Si ce n'est pas ça, essayez de mieux expliquer ce que vous attendez avec des exemples.

Cdlt

[lourid]

Bonsoir Arturo

Dans le fichier que je reçois dans la colonne B, figurent les dates des différents mois dans ce cas, mois de mars. il y a tous les jours sauf les samedis et les dimanches et je les saisis manuellement
J'aimerais pouvoir les insérer automatiquement

00FIA 000001 20190301 FE070000
00FIA 000001 20190304 O070000
00FIA 000001 20190305 O070000
00FIA 000001 20190306 O070000
00FIA 000001 20190306 RL020000
00FIA 000001 20190307 O070000
00FIA 000001 20190308 O070000
00FIA 000001 20190311 RL070000
00FIA 000001 20190312 O070000
00FIA 000001 20190313 O070000
00FIA 000001 20190314 O070000
00FIA 000001 20190315 O070000
00FIA 000001 20190318 O070000
00FIA 000001 20190319 O070000
00FIA 000001 20190320 O070000
00FIA 000001 20190321 O070000
00FIA 000001 20190322 O070000
00FIA 000001 20190325 O070000
00FIA 000001 20190326 O070000
00FIA 000001 20190327 O070000
00FIA 000001 20190328 O070000
00FIA 000001 20190329 O070000

[ARTURO83]

Bonjour,

Décidemment on ne se comprend pas, dans la feuille "Foglio3" du fichier que je vous ai renvoyé, il y a bien les samedis et dimanches en caractères gras.
Pièce jointe 480194

Je vous renvoie le fichier
Pièce jointe 480197

Cdlt

[lourid]

certes, mais à chaque fois je dois entrer manuellement les samedis et dimanches du mois et je voudrais le faire automatiquement
si possible. Je les mets en gras pour mettre en évidence
J'espère avoir expliqué

[ARTURO83]

RE,

Je me répète, lorsque vous cliquez sur le bouton "Copiare" les samedis et dimanches sont bien ajoutés automatiquement dans la feuille "Foglio3", ne l'avez-vous pas constaté?

Je vous remets les images de la situation avant et après avec en rouge les samedis et les dimanches.

Avant (foglio2) , extraction des données brutes sans les samedis et dimanches
Pièce jointe 480250

Après (foglio3) avant la mise en forme définitive
Pièce jointe 480253

Vous dites: à chaque fois je dois entrer manuellement les samedis et dimanches du mois Pourquoi puisqu'ils s'ajoutent automatiquement à la fin de l'exécution de la macro dans la feuille "Foglio3"?

Que voulez vous de plus que ce qui est déjà fourni?
Faites le test et déposez ici le résultat obtenu avec des commentaires si cela ne correspond pas à vos attentes.

Cdlt

[lourid]

Salut Arturo a envoyé ce que la macro me donne, ne me rends pas les samedis et les dimanches et les total des heures ne sont pas exacts

[ARTURO83]

Bonjour,

Comment voulez-vous que ça marche, je viens de m'apercevoir que dans les dernières images que vous avez mis à disposition, les dates ne correspondent pas au fichier d'origine.
Quel est le vrai format de date 20190101 (fichier d'origine) ou 0120190101(dernières images déposées par vos soins)?

[lourid]

Bonsoir
je m'excuse, les dates sont 0120190404

[ARTURO83]

Bonjour,

Correctif avec traitement du nouveau format de dates

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
 
Option Compare Text
 
Sub Copiare()
    Dim DerLig_F1 As Long, DerLig_F2 As Long, i As Long, j As Long, L As Long
    Dim ROL As Long, ORD As Long, FE As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Matr As String
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("Foglio2")
    Set f2 = Sheets("Foglio3")
    f2.Cells.Clear
 
    DerLig_F1 = f1.[A10000].End(xlUp).Row
    f1.Range(Cells(1, "A"), Cells(DerLig_F1, "C")).Copy Destination:=f2.Cells(1, "A")
 
    Matr = Cells(1, "A")
    For i = 2 To DerLig_F1
        If f2.Cells(i, "A") = Matr Then
            f2.Cells(i, "A") = ""
        Else
            Matr = Cells(i, "A")
        End If
    Next
 
    f2.Select
    'Formule pour récupérer le jour
    Range("D1:D" & DerLig_F1).FormulaR1C1 = "=IF(RC[-1]<>"""",DATE(MID(RC[-2],3,4),MID(RC[-2],7,2),RIGHT(RC[-2],2))*1,"""")"
    Columns("D:D").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
    For i = DerLig_F1 + 1 To 2 Step -1
        If Format(Cells(i - 1, "D"), "dddd") = "Vendredi" Then
            If Cells(i, "B") <> "" Then Rows(i & ":" & i + 1).Insert Shift:=xlDown
            Cells(i, "D") = Cells(i - 1, "D") + 1
            Cells(i, "B") = Year(Cells(i, "D")) & Format(Month(Cells(i, "D")), "00") & Format(Day(Cells(i, "D")), "00")
            Cells(i + 1, "D") = (Cells(i, "D") + 1) * 1
            Cells(i + 1, "B") = Year(Cells(i + 1, "D")) & Format(Month(Cells(i + 1, "D")), "00") & Format(Day(Cells(i + 1, "D")), "00")
            Range(Cells(i, "C"), Cells(i + 1, "C")) = "R000000"
            With Range(Cells(i, "B"), Cells(i + 1, "C")).Font
                .Name = "Calibri"
                .Size = 11
                .ColorIndex = 1
            End With
        End If
    Next i
 
    DerLig_F2 = [B10000].End(xlUp).Row
    For i = DerLig_F2 To 2 Step -1
        ROL = 0
        ORD = 0
        FE = 0
        L = i
        For j = L To 1 Step -1
            Select Case Left(Cells(L, "C"), 1)
                Case Is = "R"
                    ROL = ROL + Right(Cells(L, "C"), 6) * 1
                Case Is = "O"
                    ORD = ORD + Right(Cells(L, "C"), 6) * 1
                Case Is = "F"
                    FE = FE + Right(Cells(L, "C"), 6) * 1
                End Select
                If Cells(L, "A") <> "" Then Exit For
                L = L - 1
        Next j
        If i <> DerLig_F2 Then Rows(i + 2 & ":" & i + 4).Insert Shift:=xlDown
        If i = DerLig_F2 Then
            Cells(i + 1, "B") = "ROL"
            Cells(i + 1, "C") = ROL
            Cells(i + 2, "B") = "ORD"
            Cells(i + 2, "C") = ORD
            Cells(i + 3, "B") = "FE"
            Cells(i + 3, "C") = FE
        Else
            Cells(i + 2, "B") = "ROL"
            Cells(i + 2, "C") = ROL
            Cells(i + 3, "B") = "ORD"
            Cells(i + 3, "C") = ORD
            Cells(i + 4, "B") = "FE"
            Cells(i + 4, "C") = FE
        End If
        i = L - 1
    Next i
 
    For i = 1 To DerLig_F2
        If Cells(i, "A") <> "" Then
            Matr = Cells(i, "A")
            Rows(i).Insert Shift:=xlDown
            Cells(i, "B") = Matr
            With Cells(i, "B").Font
                .Name = "Calibri"
                .Size = 11
                .ColorIndex = 3
            End With
            i = i + 1
        End If
    Next
    Range("A:A,D:D").Delete Shift:=xlToLeft
End Sub

Nouveau fichier avec les nouvelles dates
Pièce jointe 481236

Cdlt

[lourid]

Bonsoir, j'ai téléchargé le fichier et j'ai essayé de lancer la macro, mais dans la feuille 3, les dates sans les samedis et les dimanches sont indiquées. Peut-être que je dois formater la colonne?