Comment vérifier si la cellule avant dans la rangée est la même avant d'ajouter au compteur

Question

Je travaille sur une feuille de temps qui calcule les heures dans une vue hebdomadaire par employé. J'ai mis en place un code qui détermine si l'employé fait encore partie de l'entreprise, en congé sans solde, quitte l'entreprise ou est déjà parti. Ce que j'essaie de faire est de créer une table qui me dit le nombre de menuisiers, de sortants et ceux qui sont en congé non payé par semaine.

Après avoir appliqué le code pour trier mes données, il ressemble à ceci:

où je remplacer les valeurs aléatoires qui existaient avant avec des descriptions plus significatives.

Je veux créer une table qui ajoute au compteur de menuisier la première fois dans la ligne la valeur n'est pas jointe 'donc je ne duplique pas le nombre. Par exemple, ID 1, je ne veux pas compter cette personne comme menuisier dans les semaines 2 - 5, seulement dans la semaine 2.

Ceci est mon code jusqu'à présent Je regarde les lignes par colonne avant de passer à autre chose à la colonne suivante:

Dim LastCol As Long 
Dim LastRow As Long 
Dim I As Long 
Dim Z As Long 
Dim Q As Long 
Dim Joined As Integer 
Dim ws As Worksheet 

'set worksheet to use 
Set ws = Sheets("Sheet1") 

With ws 
    'Find last col and row for range 
    LastCol = ws.Cells(3, Columns.Count).End(xlToLeft).Column 
    LastRow = ws.Cells(Rows.Count, D).End(xlUp).Row 

For I = 3 To LastCol 
    NotJoined = 0 
     For Z = 4 To LastRow 
      'check if cell is > 0 
      If ws.Cells(Z, I).Value > 0 Then 
       Joined = Joined + 1 
      End If 
     Next Z 
    'Find last row and add value to row below 
    Q = ws.Cells(Rows.Count, I).End(xlUp).Row 
    ws.Cells(Q + 1, I).Value = Joined 
Next I 
End With 

Comment pourrais-je ajouter un moyen de ne compter un menuisier (allant de Non Inscrit à toute autre valeur)/Leaver (allant de toute valeur à x) une fois dans une ligne donnée, mais trouver ces valeurs par semaine. Je travaille à avoir une table comme ci-dessous:

Merci à l'avance!

Answer 1

J'ai fait la moitié du travail. S'il vous plaît faites le reste. C'est aussi loin que j'ai eu. Collez le code dans un module de code standard et modifiez le nom de la feuille de calcul de "Tony" à celui sur lequel vous testez.

Option Explicit 

Enum Nst       ' Status 
    ' 15 Oct 2017 
    NstNone = -3 
    NstNotJoined 
    NstOnLeave 
    NstLeft 
    NstPresent 
End Enum 

Enum Nix       ' Array index 
    ' 15 Oct 2017 
    NixPresent = 1 
    NixJoined 
    NixLeft 
    NixUnpaid 
End Enum 

Sub HeadCount() 
    ' 15 Oct 2017 

    Dim Arr() As Integer    ' Result 
    Dim Wk As Long, Ix As Nix   ' Arr() indices 
    Dim Ws As Worksheet 
    Dim LastCol As Long 
    Dim LastRow As Long 
    Dim StatusArr As Variant 
    Dim R As Long, C As Long   ' Row/Column 
    Dim Stat As Nst, NewStat As Nst  ' status 

    'set worksheet to use 
    Set Ws = Sheets("Tony") 
    StatusArr = Array(NstNotJoined, NstOnLeave, NstLeft, NstPresent) 

    With Ws 
     ' prefix a period to refer to object in With statement 
     LastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column 
     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
     ReDim Arr(1 To (LastCol - 3), 1 To NixUnpaid) 

     For R = 4 To LastRow 
      Stat = NstNone     ' unable to determine changes in Wk 1 
      For C = 4 To LastCol 
       Wk = C - 3 
       NewStat = StatusArr(Application.Match(Val(.Cells(R, C).Value), StatusArr, 1) - 1) 
       If NewStat <> Stat Then  ' count changes 
        ' Count joiners 
        If (Stat = NstNotJoined) And (NewStat = NstPresent) Then 
         Arr(Wk, NixJoined) = Arr(Wk, NixJoined) + 1 
        End If 
        ' count leavers 
        If (Stat <> NstLeft) And (NewStat = NstLeft) Then 
         Arr(Wk, NixLeft) = Arr(Wk, NixLeft) + 1 
        End If 
       End If 

       Stat = NewStat 
       If Stat = NstOnLeave Then Arr(Wk, NixUnpaid) = Arr(Wk, NixUnpaid) + 1 
       If Stat = NstPresent Then Arr(Wk, NixPresent) = Arr(Wk, NixPresent) + 1 
      Next C 
     Next R 

     .Cells(20, "D").Resize(UBound(Arr, 2), UBound(Arr, 1)).Value = Application.Transpose(Arr) 
    End With 
End Sub 

J'ai introduit la logique suivante dans vos enregistrements.

1. -2 signifie "Pas encore rejoint"
2. -1 signifie "en congé" (probablement non)
3. 0 ou des moyens blancs "ne fonctionne pas" (probablement à gauche)
4. Tout autre nombre positif représente les heures de travail (supposé fonctionner)

Veuillez utiliser ces chiffres sur la feuille de travail au lieu des textes que vous avez actuellement. Si besoin est, le code pourrait être écrit pour les traduire. Dans le code, ces nombres sont représentés dans Enum Nst. NstNone est utilisé au début de la semaine. Je pense que votre système est défectueux à ce moment-là parce que vous ne pouvez pas dire combien de personnes ont rejoint ou quitté sans connaître le statut précédent. NstNone comble le fossé.

La dernière ligne de code détermine que la sortie sera écrite dans la plage D20: H23 de la même feuille sur laquelle les données sont trouvées. Les données existantes seront écrasées. Assurez-vous de ne rien écrire dans la colonne A sous les ID des employés, car la macro utilise la colonne A pour déterminer le nombre d'employés à évaluer.

Le résultat aura autant de colonnes que vous avez de semaines ci-dessus. Il aura 4 lignes comme déterminé par Enum Nix, ce qui signifie que les employés présents, rejoint, quitté et en congé sans solde.L'idée est que vous collez cette liste dans une table où vous avez les légendes et le formatage que vous voulez. Vous pouvez changer la séquence en modifiant l'Enum Nix. Assurez-vous simplement d'attribuer la valeur = 1 au prénom. (Et ne mélangez pas Enum Nst!)

Mes chiffres ne correspondent pas à ceux de votre résultat. C'est parce que je n'ai pas compris votre résultat. Cependant, je pense que les chiffres sont là, et si vous en avez besoin, ils seront faciles à intégrer dans le système établi.