Boucle for

Le 21/02/2018 à 16:50

Bonjour tout le monde,

J'ai une macro qui cherche dans le calendrier du mois les journées travaillées en Samedi et Dimanche puis alimente ces journées dans un le tableau de la feuille "feuil28" pour chaque personne.

Pour le moment je suis arrivé à trouver comment faire si une ligne contient une seule fois la condition que j'ai mise.

Cependant quand il y a plusieurs samedi ou dimanche travaillés je n'arrive pas à trouver comment alimenter le tableau. la macro prend toujours la dernière date.

le but est d'alimenter les dates et les noms dans le tableau de la deuxième feuille. en cas de doublon, la macro doit les alimenter dans plusieurs ligne.

Vous trouverez ci-joint le fichier. Le bouton de la 2eme feuille permet de déclencher ladite macro

Merci d'avance pour votre aide.

Cordialement

Le 21/02/2018 à 18:16

Le forum,

À tester si ça convient :

Option Explicit

Sub jours_inhabituels()

Dim jti As Worksheet
''Dim jan As Worksheet, fev As Worksheet, mars As Worksheet, avr As Worksheet, mai As Worksheet, juin As Worksheet, juil As Worksheet, aout As Worksheet, sept As Worksheet, oct As Worksheet, nov As Worksheet, dec As Worksheet
Dim conso As String
Dim DerLig, Derlig2 As Integer
Dim LeMois As Worksheet
Dim J, i As Integer
Dim LM As Byte

Set LeMois = ThisWorkbook.Sheets("Janvier 2018") ' avec la variable LeMois, le code sera le même pour toutes les feuilles
Set jti = ThisWorkbook.Worksheets("feuil28")

Derlig2 = jti.Cells(Rows.Count, "A").End(xlUp).Row  ' trouve dernière ligne
jti.Range(Cells(5, "A"), Cells(Derlig2, "B")).ClearContents ' vide la plage avant le traitement
DerLig = LeMois.Cells(Rows.Count, "B").End(xlUp).Row ' trouve dernière ligne

For J = 5 To DerLig   ' parcour la plage en hauteur
    For i = 2 To 31   ' parcour la plage en largeur
        If LeMois.Cells(J, 1) <> "" Then   ' si la cellule n'est pas vide
            If LeMois.Cells(4, i) = "samedi" Or LeMois.Cells(4, i) = "dimanche" Then
                If LeMois.Cells(J, i) = "JT" Or LeMois.Cells(J, i) = "1/2 JT" Then
                    Derlig2 = jti.Cells(Rows.Count, "A").End(xlUp).Row + 1  ' trouve la dernière ligne vide
                    If Derlig2 < 5 Then Derlig2 = 5    ' au premiere passage la première ligne vide pourrait être moins que la 5e
                    jti.Cells(Derlig2, 1) = LeMois.Cells(J, 1)
                    jti.Cells(Derlig2, 2) = LeMois.Cells(3, i)
                End If
            End If
        End If
    Next i
Next J
End Sub

Jim

Le 22/02/2018 à 10:12

Jim,

Merci beaucoup

le code fonctionne comme je veux

Le 22/02/2018 à 11:18

Bonjour

J'ai repris le code et l'ai généralisé sur mon fichier. ça donne résultat correcte mais je voulais le développer un peu plus.

En effet, je vous que les date s'afficheront à partir de la première ligne, si la personne est la même pour le reste du mois. Si le nombre de ligne du mois dépasse le nombre des lignes du mois précédent, la macro alimente la ligne vide d'après...

vous trouverez ci-joint le fichier.

Merci d'avance.

Bonne journée

Le 22/02/2018 à 11:19

Bonjour

J'ai repris le code et l'ai généralisé sur mon fichier. ça donne résultat correcte mais je voulais le développer un peu plus.

En effet, je vous que les date s'afficheront à partir de la première ligne, si la personne est la même pour le reste du mois. Si le nombre de ligne du mois dépasse le nombre des lignes du mois précédent, la macro alimente la ligne vide d'après...

vous trouverez ci-joint le fichier.

Merci d'avance.

Bonne journée

Jim55 a écrit :

Le forum,

À tester si ça convient :

Option Explicit

Sub jours_inhabituels()

Dim jti As Worksheet
''Dim jan As Worksheet, fev As Worksheet, mars As Worksheet, avr As Worksheet, mai As Worksheet, juin As Worksheet, juil As Worksheet, aout As Worksheet, sept As Worksheet, oct As Worksheet, nov As Worksheet, dec As Worksheet
Dim conso As String
Dim DerLig, Derlig2 As Integer
Dim LeMois As Worksheet
Dim J, i As Integer
Dim LM As Byte

Set LeMois = ThisWorkbook.Sheets("Janvier 2018") ' avec la variable LeMois, le code sera le même pour toutes les feuilles
Set jti = ThisWorkbook.Worksheets("feuil28")

Derlig2 = jti.Cells(Rows.Count, "A").End(xlUp).Row  ' trouve dernière ligne
jti.Range(Cells(5, "A"), Cells(Derlig2, "B")).ClearContents ' vide la plage avant le traitement
DerLig = LeMois.Cells(Rows.Count, "B").End(xlUp).Row ' trouve dernière ligne

For J = 5 To DerLig   ' parcour la plage en hauteur
    For i = 2 To 31   ' parcour la plage en largeur
        If LeMois.Cells(J, 1) <> "" Then   ' si la cellule n'est pas vide
            If LeMois.Cells(4, i) = "samedi" Or LeMois.Cells(4, i) = "dimanche" Then
                If LeMois.Cells(J, i) = "JT" Or LeMois.Cells(J, i) = "1/2 JT" Then
                    Derlig2 = jti.Cells(Rows.Count, "A").End(xlUp).Row + 1  ' trouve la dernière ligne vide
                    If Derlig2 < 5 Then Derlig2 = 5    ' au premiere passage la première ligne vide pourrait être moins que la 5e
                    jti.Cells(Derlig2, 1) = LeMois.Cells(J, 1)
                    jti.Cells(Derlig2, 2) = LeMois.Cells(3, i)
                End If
            End If
        End If
    Next i
Next J
End Sub

Jim

Le 22/02/2018 à 16:41

Le forum,

Je ne comprends pas bien ta dernière demande.

Peux-tu me donner un exemple du résultat souhaité?

En attendant je te donne un code qui fait tous les mois sans devoir répéter le bloc pour chaque mois.

Aussi, il n'y a que l'année à changer pour que ça fonctionne en 2019 ...

Option Explicit

Sub jour_inhabituel()
Dim Jti As Worksheet
Dim conso As String
Dim DerLig, Derlig2, derlig3 As Integer
Dim J, i, K, Y, Z As Integer
Dim Lesfeuil As String
Dim Lannee As Integer
Dim myArrayList As Object

If MsgBox("La feuille sera effacée. Souhaitez-vous continuez ?", vbQuestion + vbYesNo, "QUESTION ...") = vbNo Then Exit Sub

Set myArrayList = CreateObject("System.Collections.ArrayList")
    myArrayList.Add "Janvier"
    myArrayList.Add "Février"
    myArrayList.Add "Mars"
    myArrayList.Add "Avril"
    myArrayList.Add "Mai"
    myArrayList.Add "Juin"
    myArrayList.Add "Juillet"
    myArrayList.Add "Août"
    myArrayList.Add "Septembre"
    myArrayList.Add "Octobre"
    myArrayList.Add "Novembre"
    myArrayList.Add "Décembre"

Lannee = 2018
Set Jti = ThisWorkbook.Worksheets("Jours+")
Derlig2 = Jti.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' trouve dernière ligne
Jti.Cells(4, 1) = "Les personnes" ' ceci afin que la cellule ne soit pas vide
Jti.Select
Jti.Range("A5:Y" & Derlig2).ClearContents ' vide la plage avant le traitement

Y = 2
Z = 3
For K = 0 To myArrayList.Count - 1
    Lesfeuil = myArrayList(K) & " " & Lannee
    Derlig2 = Jti.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' trouve dernière ligne
    If Derlig2 < 5 Then Derlig2 = 5
    DerLig = Worksheets(Lesfeuil).Cells(Rows.Count, "A").End(xlUp).Row ' trouve dernière ligne

    With Worksheets(Lesfeuil)
        For J = 5 To DerLig   ' parcour la plage en hauteur
            For i = 2 To 32   ' parcour la plage en largeur
                If .Cells(J, 1) <> "" Then   ' si la cellule n'est pas vide
                    If .Cells(4, i) = "samedi" Or .Cells(4, i) = "dimanche" Then
                        If .Cells(J, i) = "JT" Or .Cells(J, i) = "1/2 JT" Then
                            Derlig2 = Jti.Cells(Rows.Count, "A").End(xlUp).Row + 1  ' trouve la dernière ligne vide
                            Jti.Cells(Derlig2, 1) = .Cells(J, 1)
                            Jti.Cells(Derlig2, Y) = .Cells(3, i)
                         End If
                    End If

                    If .Cells(J, i) = "REC" Or .Cells(J, i) = "1/2 REC" Then
                        Derlig2 = Jti.Cells(Rows.Count, "A").End(xlUp).Row + 1  ' trouve la dernière ligne vide
                        Jti.Cells(Derlig2, 1) = .Cells(J, 1)
                        Jti.Cells(Derlig2, Z) = .Cells(3, i)
                    End If
                End If
            Next i
        Next J
        Y = Y + 2
        Z = Z + 2
    End With
Next K
End Sub

Jim

Le 22/02/2018 à 17:59

Bonjour

Tout d'abord je tiens à te remercier pour ce code.

Ensuite, tu trouveras ci-joint le fichier avec un onglet "résultat voulu". Je veux rassembler tout dans un seul bloc...

Merci encore

Jim55 a écrit :

Le forum,

Je ne comprends pas bien ta dernière demande.

Peux-tu me donner un exemple du résultat souhaité?

En attendant je te donne un code qui fait tous les mois sans devoir répéter le bloc pour chaque mois.

Aussi, il n'y a que l'année à changer pour que ça fonctionne en 2019 ...

Option Explicit

Sub jour_inhabituel()
Dim Jti As Worksheet
Dim conso As String
Dim DerLig, Derlig2, derlig3 As Integer
Dim J, i, K, Y, Z As Integer
Dim Lesfeuil As String
Dim Lannee As Integer
Dim myArrayList As Object

If MsgBox("La feuille sera effacée. Souhaitez-vous continuez ?", vbQuestion + vbYesNo, "QUESTION ...") = vbNo Then Exit Sub

Set myArrayList = CreateObject("System.Collections.ArrayList")
    myArrayList.Add "Janvier"
    myArrayList.Add "Février"
    myArrayList.Add "Mars"
    myArrayList.Add "Avril"
    myArrayList.Add "Mai"
    myArrayList.Add "Juin"
    myArrayList.Add "Juillet"
    myArrayList.Add "Août"
    myArrayList.Add "Septembre"
    myArrayList.Add "Octobre"
    myArrayList.Add "Novembre"
    myArrayList.Add "Décembre"

Lannee = 2018
Set Jti = ThisWorkbook.Worksheets("Jours+")
Derlig2 = Jti.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' trouve dernière ligne
Jti.Cells(4, 1) = "Les personnes" ' ceci afin que la cellule ne soit pas vide
Jti.Select
Jti.Range("A5:Y" & Derlig2).ClearContents ' vide la plage avant le traitement

Y = 2
Z = 3
For K = 0 To myArrayList.Count - 1
    Lesfeuil = myArrayList(K) & " " & Lannee
    Derlig2 = Jti.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' trouve dernière ligne
    If Derlig2 < 5 Then Derlig2 = 5
    DerLig = Worksheets(Lesfeuil).Cells(Rows.Count, "A").End(xlUp).Row ' trouve dernière ligne

    With Worksheets(Lesfeuil)
        For J = 5 To DerLig   ' parcour la plage en hauteur
            For i = 2 To 32   ' parcour la plage en largeur
                If .Cells(J, 1) <> "" Then   ' si la cellule n'est pas vide
                    If .Cells(4, i) = "samedi" Or .Cells(4, i) = "dimanche" Then
                        If .Cells(J, i) = "JT" Or .Cells(J, i) = "1/2 JT" Then
                            Derlig2 = Jti.Cells(Rows.Count, "A").End(xlUp).Row + 1  ' trouve la dernière ligne vide
                            Jti.Cells(Derlig2, 1) = .Cells(J, 1)
                            Jti.Cells(Derlig2, Y) = .Cells(3, i)
                         End If
                    End If

                    If .Cells(J, i) = "REC" Or .Cells(J, i) = "1/2 REC" Then
                        Derlig2 = Jti.Cells(Rows.Count, "A").End(xlUp).Row + 1  ' trouve la dernière ligne vide
                        Jti.Cells(Derlig2, 1) = .Cells(J, 1)
                        Jti.Cells(Derlig2, Z) = .Cells(3, i)
                    End If
                End If
            Next i
        Next J
        Y = Y + 2
        Z = Z + 2
    End With
Next K
End Sub

Jim

5jours-inhabituels.xlsm (250.50 Ko)
Le 23/02/2018 à 13:12

Bonjour khaledtn, le forum,

J'ai bien essayé de résoudre cela, mais mes connaissances ne sont pas suffisantes.

J’espère bien que quelqu'un prendra la relève.

Bon courage

Jim

Le 23/02/2018 à 13:44

Merci Jim

Bonne journée

Jim55 a écrit :

Bonjour khaledtn, le forum,

J'ai bien essayé de résoudre cela, mais mes connaissances ne sont pas suffisantes.

J’espère bien que quelqu'un prendra la relève.

Bon courage

Jim

Rechercher des sujets similaires à "boucle"