Discussion :

[navta12]

Bonjour,


Le problème est le suivant:

je veux sur une file de cellules que le programme me compte 7 cellules avec la même valeur ’’X’’ une fois comptabilisé, elle copie le numéro ou c’est produit l’événement et le renvoi au final de la file, le même procédé se répète pour l’événement 13, 19 et 25 (cumul de 7 série de cellules avec des X). le problème est qu’and il y a une D ou une cellule avec un autre caractère le programme s’arrête, ou il devrait sauter cette cellule est suivre avec le compteur. Je sais pas si me se suis bien expliquer mais ça marche avec le suivant exemple :
sur excel :
de A1 a AD1 (1,2,3,…30 denier numero)
de A2 a AD2 (X,X,X,…,X remplir avec X)
ça marche

si de A2 a AD2 (X,X,X,D,X,X,D,…X) le programme s’arrête

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
 
 
Sub Programme_Principal()
Dim Num_Col As Integer
Dim Col_Fin As Integer
    Num_Col = 1
    While Cells(2, Num_Col) = "X"
        Col_Fin = Num_Col
        While Cells(2, Col_Fin) = Cells(2, Col_Fin + 1)
            Col_Fin = Col_Fin + 1
            If Col_Fin = 7 Then
                Cells(2, 33) = Cells(1, Col_Fin)
            End If
            If Col_Fin = 13 Then
                Cells(2, 34) = Cells(1, Col_Fin)
                Cells(2, 35) = Cells(1, Col_Fin)
            End If
            If Col_Fin = 19 Then
                Cells(2, 36) = Cells(1, Col_Fin)
                Cells(2, 37) = Cells(1, Col_Fin)
            End If
            If Col_Fin = 25 Then
                Cells(2, 38) = Cells(1, Col_Fin)
                Cells(2, 39) = Cells(1, Col_Fin)
            End If
        Wend
        Num_Col = Col_Fin + 1
    Wend
End Sub

merci

[Invité]

Bonjour,

Vos explications ne permettent pas de bien comprendre ce que vous souhaitez car vous faites mention de séries de 7 mais on ne voit pas à quel moment vous remettez le compteur à 0 :

• Faut il indiquer la position de la colonne à chaque fois qu'on aura atteint 7 dans un compteur de "X" ? Le compteur étant remis à 0 à chaque nouvelle série.
• Faut il indiquer la position de la colonne à chaque fois qu'on aura atteint 7, 13,19 et 25 dans un compteur de "X" ?
• Faut-il indiquer le nombre de "X" qu'on aura atteint aux colonnes 7, 13, 19, 25 ?

Si c'est la deuxième proposition qui doit être retenue :

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
Sub Programme_Principal()
 
Dim AireTestee As Range
Dim CelluleTestee As Range
Dim NbColX As Long
Dim CtrI As Long
 
 
    For CtrI = 2 To ActiveSheet.UsedRange.Rows.Count
 
      NbColX = 0
      Set AireTestee = Range(ActiveSheet.Cells(CtrI, 1), ActiveSheet.Cells(CtrI, 30))
      For Each CelluleTestee In AireTestee
            If CelluleTestee = "X" Then NbColX = NbColX + 1
            Select Case NbColX
            Case 7
             CelluleTestee.Offset(0, 33 - CelluleTestee.Column) = CelluleTestee.Column
            Case 13
             CelluleTestee.Offset(0, 34 - CelluleTestee.Column) = CelluleTestee.Column
             CelluleTestee.Offset(0, 35 - CelluleTestee.Column) = CelluleTestee.Column
            Case 19
             CelluleTestee.Offset(0, 36 - CelluleTestee.Column) = CelluleTestee.Column
             CelluleTestee.Offset(0, 37 - CelluleTestee.Column) = CelluleTestee.Column
            Case 25
             CelluleTestee.Offset(0, 38 - CelluleTestee.Column) = CelluleTestee.Column
             CelluleTestee.Offset(0, 39 - CelluleTestee.Column) = CelluleTestee.Column
            End Select
      Next CelluleTestee
 
    Set AireTestee = Nothing
 
    Next CtrI
End Sub

Cordialement.

[mercatog]

Une autre proposition

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
Sub Programme_Principal()
Dim LastLig As Long, Lig As Long
Dim c As Range
Dim S As Byte
 
Application.ScreenUpdating = False
With Worksheets("MaFeuille")                       'A adapter
    LastLig = .UsedRange.Rows.Count
    For Lig = 2 To LastLig
        .Range("AG" & Lig).Resize(1, 7).ClearContents
        For Each c In .Range("A" & Lig).Resize(1, 31)
            If c.Value = "X" Then
                S = S + 1
                Select Case S
                    Case 7: .Range("AG" & Lig) = .Cells(1, c.Column)
                    Case 13: .Range("AH" & Lig).Resize(1, 2) = .Cells(1, c.Column)
                    Case 19: .Range("AJ" & Lig).Resize(1, 2) = .Cells(1, c.Column)
                    Case 25: .Range("AL" & Lig).Resize(1, 2) = .Cells(1, c.Column)
                End Select
            End If
        Next c
        S = 0
    Next Lig
End With
End Sub

[navta12]

Merci Eric,

Selon votre code :

Vos explications ne permettent pas de bien comprendre ce que vous souhaitez car vous faites mention de séries de 7 mais on ne voit pas à quel moment vous remettez le compteur à 0 :

Faut il indiquer la position de la colonne à chaque fois qu'on aura atteint 7 dans un compteur de "X" ? Le compteur étant remis à 0 à chaque nouvelle série.

-->OUI, une fois que le compteur atteint 7 "X" il indique le numéro de la colonne, s’il y a 2 série de 7 "X" (13) il prend la colonne et marque 2 fois la colonne, s’il ni a pas d’interruption entre a la 2° et 3° série de 7"X" (19) il marque la colonne idem a l'antérieur, et continue. Il devra se mètre a 0 seulement après avoir un autre caractère différent de "X" dans ce cas d'une "D" ou autre, après une D la "X" suivante reprend le compteur a 1.


Faut il indiquer la position de la colonne à chaque fois qu'on aura atteint 7, 13,19 et 25 dans un compteur de "X" ? OUI

Faut-il indiquer le nombre de "X" qu'on aura atteint aux colonnes 7, 13, 19, 25 ? NON

j'adjoint un fichier excel pour mieux comprendre la situation...ce qui est en jaune devrais être ce que je souhaite faire..

Merci beaucoup

[Invité]

Bonsoir,

Cela aurait été plus facile de comprendre en indiquant : On prend le numéro de la colonne si 7 cellules consécutives ont la valeur X.

Question : Quelle est la logique de la répétition de la colonne 28 (ligne 2) ou 13 (ligne 12) ?

OK vu pour la logique de la répétition, je n'avais pas bien lu.

Cordialement.

Si on parle de séries de 7, pourquoi les colonnes 13 et 28 et pourquoi pas les colonnes 14 et 29 sur la ligne 2 ?

Cordialement.

[mercatog]

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
Sub Programme_Principal()
Dim S As Byte, k As Byte, n As Byte
Dim LastLig As Long, Lig As Long
Dim Flag As Boolean
Dim c As Range
 
Application.ScreenUpdating = False
With Worksheets("Sheet3")                          'A adapter
    LastLig = .UsedRange.Rows.Count
    For Lig = 2 To LastLig
        .Range("AG" & Lig).Resize(1, 7).ClearContents
        For Each c In .Range("A" & Lig).Resize(1, 31)
            If c.Value = "X" Then
                S = S + 1
                If S = 7 Then
                    n = 1 - (k > 0 And Not Flag)   'Ou simplement n = IIf(k = 0 Or Flag, 1, 2)
                    .Range("AG" & Lig).Offset(0, k).Resize(1, n) = .Cells(1, c.Column)
                    k = k + n: S = 1: Flag = False
                End If
            Else
                S = 0: Flag = True
            End If
        Next c
        k = 0: S = 0: Flag = False
    Next Lig
End With
End Sub

[navta12]

Cela marche a la perfection c’est justement ce que je cherché, en faite ces un registre de personne qui travaille en forme continue, s’ils travaillent 7 jours continue (7 X) je dois lui retourner un jour de travaille plus tard dans le mois ou cumuler, s’ils travaillent 14 jour continue je lui dois 1 jour + 1 jour additionnel en total 3 jour, s’il travaille 21 jour continue ça s’accumule 1+1 au total 5 jours cumuler, mais pour cela je dois s’avoir quelle jour du mois l’événement ce produit (c’est des personnes qui travaillent dans les bateaux de transport maritime), actuellement je le fais a la main pour 120 personnes, maintenant grâce au programme ça va aller un peu plus rapide, Merci Beaucoup, Résolut.