Sujet Précédent Sujet Suivant

Moyenne par personne par mois Erreur 1004

Fermé
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016 - Modifié par hajars le 24/08/2016 à 15:44
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016 - 29 août 2016 à 13:03
Bonjour,


Est ce que vous pourrez m'aider pour trouver l'erreur que j'ai faite dans ce code.
Je cherche à calculer la moyenne par mois par chaque personne

J'ai des 0 partout dans les resultats et c est pas normal, j arrive pas a voir ou est ce que j ai fait erreur 



Sub ScoringUpdater()


Dim nbJan As Integer, nbFeb As Integer, nbApr As Integer, nbMar As Integer, nbMay As Integer
Dim nbJun As Integer, nbJul As Integer, nbAug As Integer, nbSep As Integer, nbOct As Integer
Dim nbNov As Integer, nbDec As Integer, nbTotal As Integer

Dim sumJan As Long, sumFeb As Long, sumApr As Long, sumMar As Long, sumMay As Long
Dim sumJun As Long, sumJul As Long, sumAug As Long, sumSep As Long, sumOct As Long
Dim sumNov As Long, sumDec As Long, sumTotal As Long
Dim lastlign As Integer
Dim ligTab As Integer
Dim ActualYear As Integer
Dim cursorPerson As Integer
Dim rCell As Range



'store the lenght of the table from "Scoring Updater"
ligTab = Worksheets("Scoring Updater").Range("A" & Rows.Count).End(xlUp).Row

nbJan = 0
nbFeb = 0
nbMar = 0
nbApr = 0
nbMay = 0
nbJun = 0
nbJul = 0
nbAug = 0
nbSep = 0
nbOct = 0
nbNov = 0
nbDec = 0
nbTotal = 0

sumJan = 0
sumFeb = 0
sumMar = 0
sumApr = 0
sumMay = 0
sumJun = 0
sumJul = 0
sumAug = 0
sumSep = 0
sumOct = 0
sumNov = 0
sumDec = 0
myTotal = 0

'store the actual year
ActualYear = Year(Date)
Worksheets("Scoring Updater").Range("A1").Value = ActualYear

cursorPerson = 0

'find and place the number of update per month
For Each rCell In Worksheets("Scoring Updater").Range("A4:A" & ligTab)
    For i = 2 To lastlign
        If IsDate(Worksheets("All").Range("G" & i).Value) And IsDate(Worksheets("All").Range("L" & i).Value) And Year(Worksheets("All").Range("G" & i).Value) = ActualYear Then
       
                If rCell = Worksheets("All").Range("K" & i).Value Then
                    Select Case Month(Worksheets("All").Range("G" & i).Value)
                    Case 1
                        nbJan = nbJan + 1
                        sumJan = (Worksheets("All").Range("L" & i).Value - Worksheets("All").Range("G" & i).Value) + sumJan
                       ' nbTotal = nbTotal + 1
                    Case 2
                        nbFeb = nbFeb + 1
                        sumFev = (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i)) + sumFev
                        'nbTotal = nbTotal + 1
                    Case 3
                        nbMar = nbMar + 1
                        sumMar = (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i)) + sumMar
                       ' nbTotal = nbTotal + 1
                    Case 4
                        nbApr = nbApr + 1
                        sumApr = sumApr + (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i))
                        'nbTotal = nbTotal + 1
                    Case 5
                        nbMay = nbMay + 1
                        sumMay = sumMay + (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i))
                        'nbTotal = nbTotal + 1
                    Case 6
                        nbJun = nbJun + 1
                        sumJun = (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i)) + sumJun
                       ' nbTotal = nbTotal + 1
                    Case 7
                        nbJul = nbJul + 1
                        sumJul = sumJul + (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i))
                       ' nbTotal = nbTotal + 1
                    Case 8
                        nbAug = nbAug + 1
                        sumAug = sumAug + (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i))
                       ' nbTotal = nbTotal + 1
                    Case 9
                        nbSep = nbSep + 1
                        sumSep = sumSep + (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i))
                       ' nbTotal = nbTotal + 1
                    Case 10
                        nbOct = nbOct + 1
                        sumOct = (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i)) + sumOct
                       ' nbTotal = nbTotal + 1
                    Case 11
                        nbNov = nbNov + 1
                        sumNov = (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i)) + sumNov
                        'nbTotal = nbTotal + 1
                    Case 12
                        nbDec = nbDec + 1
                        sumDec = (Worksheets("All").Range("L" & i) - Worksheets("All").Range("G" & i)) + sumDec
                        'nbTotal = nbTotal + 1
                    End Select
     
            End If
        End If
    Next

 With Worksheets("Scoring Updater").Range("B" & 4 + cursorPerson)
        .Value = sumJan
       ' .Interior.ThemeColor = xlThemeColorAccent4
       ' .Interior.TintAndShade = 0.599963377788629
       ' .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("D" & 4 + cursorPerson)
        .Value = sumFev
      '  .Interior.ThemeColor = xlThemeColorAccent4
       ' .Interior.TintAndShade = 0.599963377788629
       ' .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("F" & 4 + cursorPerson)
        .Value = sumMar
      '  .Interior.ThemeColor = xlThemeColorAccent4
       ' .Interior.TintAndShade = 0.599963377788629
       ' .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("H" & 4 + cursorPerson)
        .Value = sumApr
       ' .Interior.ThemeColor = xlThemeColorAccent4
       ' .Interior.TintAndShade = 0.599963377788629
       ' .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("J" & 4 + cursorPerson)
        .Value = sumMay
      '  .Interior.ThemeColor = xlThemeColorAccent4
       ' .Interior.TintAndShade = 0.599963377788629
      '  .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("L" & 4 + cursorPerson)
        .Value = sumJun
      '  .Interior.ThemeColor = xlThemeColorAccent4
      '  .Interior.TintAndShade = 0.599963377788629
       ' .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("N" & 4 + cursorPerson)
        .Value = sumJul
      '  .Interior.ThemeColor = xlThemeColorAccent4
      '  .Interior.TintAndShade = 0.599963377788629
      '  .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("P" & 4 + cursorPerson)
        .Value = sumAug
      '  .Interior.ThemeColor = xlThemeColorAccent4
      '  .Interior.TintAndShade = 0.599963377788629
      '  .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("R" & 4 + cursorPerson)
        .Value = sumSep
      '  .Interior.ThemeColor = xlThemeColorAccent4
      '  .Interior.TintAndShade = 0.599963377788629
     '  .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("T" & 4 + cursorPerson)
        .Value = sumOct
      '  .Interior.ThemeColor = xlThemeColorAccent4
       ' .Interior.TintAndShade = 0.599963377788629
       ' .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("V" & 4 + cursorPerson)
        .Value = sumNov
      '  .Interior.ThemeColor = xlThemeColorAccent4
      '  .Interior.TintAndShade = 0.599963377788629
      '  .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
    With Worksheets("Scoring Updater").Range("X" & 4 + cursorPerson)
        .Value = sumDec
       ' .Interior.ThemeColor = xlThemeColorAccent4
       ' .Interior.TintAndShade = 0.599963377788629
      '  .Borders.Weight = xlThin
        .HorizontalAlignment = xlCenter
    End With
   ' With Worksheets("Scoring Updater").Range("Z" & 2 + cursorPerson)
    '    .Value = myTotal / nbTotal
     '   .Interior.ThemeColor = xlThemeColorAccent4
    '    .Interior.TintAndShade = 0.599963377788629
    '    .Borders.Weight = xlThin
    '    .HorizontalAlignment = xlCenter
    '    .Font.FontStyle = "Gras"
   ' End With

    
    nbJan = 0
    nbFeb = 0
    nbMar = 0
    nbApr = 0
    nbMay = 0
    nbJun = 0
    nbJul = 0
    nbAug = 0
    nbSep = 0
    nbOct = 0
    nbNov = 0
    nbDec = 0
    nbTotal = 0
    
    cursorPerson = cursorPerson + 1
Next

    

    
End Sub





Mercii d'avance


A voir également:

2 réponses

Réponse 1 / 2
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016
25 août 2016 à 17:55
Re,

J'ai modifié le code j ai fait 3 procedures
La 1ere me sort la presentation de la page la deuxieme pour afficher les Updaters et la 3eme pour faire la moyenne et le scoring
La moyenne c est le moyenne entre deux jours L et G
Le scoring doit se faire de cette façon
• Si Moyenne = 7 ; alors Scoring = 100%
• Si Moyenne < 7 ; alors Scoring > 100%, en fonction du nombre de jours en dessous de 7. Exemple : si Av. Delay = 1, alors Scoring = (7-1)/7*100 +100 = 186%
• Si Moyenne > 7 ; alors Scoring < 100%, en considérant que 0% c’est le Av. Delay le plus élevé parmi les Updaters. Exemple : si max Av. Delay = 25 et si Av. Delay de Anh Nguyen = 13, alors Scoring de l'Updater Laura KIGHALI = (13-7)

Je comprends pas trop le calcul pour av.Delay > 7
Dans le cas ou la moyenne est 13 je dois avoir un scoring de 67%
Je sais pas comment faire pour sortir ça et les explications qui m'étaient donnés ne sont pas tres clairs
Voila mon code C est pas finalisé et c est tres tres lent ^^ 


Sub ScoringUPresentation()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Worksheets("Scoring Updater").Range("A1").Value = ""
Worksheets("Scoring Updater").Range("B1:C1").Value = "M1"
Worksheets("Scoring Updater").Range("B1:C1").MergeCells = True
Worksheets("Scoring Updater").Range("B1:C1").HorizontalAlignment = xlCenter

Worksheets("Scoring Updater").Range("D1:E1").Value = "M2"
Worksheets("Scoring Updater").Range("D1:E1").MergeCells = True
Worksheets("Scoring Updater").Range("D1:E1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("F1:G1").Value = "M3"
Worksheets("Scoring Updater").Range("F1:G1").MergeCells = True
Worksheets("Scoring Updater").Range("F1:G1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("H1:I1").Value = "M4"
Worksheets("Scoring Updater").Range("H1:I1").MergeCells = True
Worksheets("Scoring Updater").Range("H1:I1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("J1:K1").Value = "M5"
Worksheets("Scoring Updater").Range("J1:K1").MergeCells = True
Worksheets("Scoring Updater").Range("J1:K1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("L1:M1").Value = "M6"
Worksheets("Scoring Updater").Range("L1:M1").MergeCells = True
Worksheets("Scoring Updater").Range("L1:M1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("N1:O1").Value = "M7"
Worksheets("Scoring Updater").Range("N1:O1").MergeCells = True
Worksheets("Scoring Updater").Range("N1:O1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("P1:Q1").Value = "M8"
Worksheets("Scoring Updater").Range("P1:Q1").MergeCells = True
Worksheets("Scoring Updater").Range("P1:Q1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("R1:S1").Value = "M9"
Worksheets("Scoring Updater").Range("R1:S1").MergeCells = True
Worksheets("Scoring Updater").Range("R1:S1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("T1:U1").Value = "M10"
Worksheets("Scoring Updater").Range("T1:U1").MergeCells = True
Worksheets("Scoring Updater").Range("T1:U1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("V1:W1").Value = "M11"
Worksheets("Scoring Updater").Range("V1:W1").MergeCells = True
Worksheets("Scoring Updater").Range("V1:W1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("X1:Y1").Value = "M12"
Worksheets("Scoring Updater").Range("X1:Y1").MergeCells = True
Worksheets("Scoring Updater").Range("X1:Y1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("Z1:AA1").Value = "TOTAL YEAR"
Worksheets("Scoring Updater").Range("Z1:AA1").MergeCells = True
Worksheets("Scoring Updater").Range("Z1:AA1").HorizontalAlignment = xlCenter
Worksheets("Scoring Updater").Range("A2").Value = "Updater"
Worksheets("Scoring Updater").Range("A3").Value = "All"
Worksheets("Scoring Updater").Range("B2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("C2").Value = "Scoring"
Worksheets("Scoring Updater").Range("B2").WrapText = True
Worksheets("Scoring Updater").Range("D2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("E2").Value = "Scoring"
Worksheets("Scoring Updater").Range("D2").WrapText = True
Worksheets("Scoring Updater").Range("F2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("G2").Value = "Scoring"
Worksheets("Scoring Updater").Range("F2").WrapText = True
Worksheets("Scoring Updater").Range("H2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("I2").Value = "Scoring"
Worksheets("Scoring Updater").Range("H2").WrapText = True
Worksheets("Scoring Updater").Range("J2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("K2").Value = "Scoring"
Worksheets("Scoring Updater").Range("J2").WrapText = True
Worksheets("Scoring Updater").Range("L2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("M2").Value = "Scoring"
Worksheets("Scoring Updater").Range("L2").WrapText = True
Worksheets("Scoring Updater").Range("N2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("O2").Value = "Scoring"
Worksheets("Scoring Updater").Range("N2").WrapText = True
Worksheets("Scoring Updater").Range("P2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("Q2").Value = "Scoring"
Worksheets("Scoring Updater").Range("P2").WrapText = True
Worksheets("Scoring Updater").Range("R2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("S2").Value = "Scoring"
Worksheets("Scoring Updater").Range("R2").WrapText = True
Worksheets("Scoring Updater").Range("T2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("U2").Value = "Scoring"
Worksheets("Scoring Updater").Range("T2").WrapText = True
Worksheets("Scoring Updater").Range("V2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("W2").Value = "Scoring"
Worksheets("Scoring Updater").Range("V2").WrapText = True
Worksheets("Scoring Updater").Range("X2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("Y2").Value = "Scoring"
Worksheets("Scoring Updater").Range("X2").WrapText = True
Worksheets("Scoring Updater").Range("Z2").Value = "Av. Delay for Update Proposal (days)"
Worksheets("Scoring Updater").Range("AA2").Value = "Scoring"
Worksheets("Scoring Updater").Range("Z2").WrapText = True



Application.DisplayAlerts = True
End Sub

Sub Updater()


'create a list of persons, sort it and place it

Dim rCell As Range
Dim ligTab As Integer
Dim testDoublon As Boolean
Dim lastlign As Integer



ligTab = 0
testDoublon = False

'make the first column larger
Columns("A:A").ColumnWidth = 65

'store the lenght of the table from "All"
lastlign = Worksheets("All").Range("B" & Rows.Count).End(xlUp).Row

'create a list of validator without doubloon
Worksheets("Scoring Updater").Range("X" & ligTab + 80).Value = Worksheets("All").Range("K2").Value
For Each rCell In Worksheets("All").Range("K2:K" & lastlign)
    
    For i = 0 To ligTab
        If rCell.Value = Worksheets("Scoring Updater").Range("X" & i + 80).Value Then
            testDoublon = True
        End If
    Next
    If testDoublon = False Then
        'ligTab count the number of elements in the list
        ligTab = ligTab + 1
        Worksheets("Scoring Updater").Range("X" & ligTab + 80).Value = rCell.Value
    End If
    testDoublon = False
        
Next rCell



'sort the range containing the list
Worksheets("Scoring Updater").Range("X80:X" & ligTab + 80).Sort key1:=Range("X80"), order1:=xlAscending

'clear the range after putting the list in the right place
For i = 0 To ligTab
    Worksheets("Scoring Updater").Range("A" & i + 3).Value = Worksheets("Scoring Updater").Range("X" & i + 80).Value
    Worksheets("Scoring Updater").Range("X" & i + 80).Clear
    With Worksheets("Scoring Updater").Range("A" & i + 3)
       ' .Interior.ThemeColor = xlThemeColorAccent5
       ' .Interior.TintAndShade = 0
        '.Borders.Weight = xlThin
    End With
Next


End Sub


Sub ScoringUpdater()




Dim nbJan As Integer, nbFeb As Integer, nbApr As Integer, nbMar As Integer, nbMay As Integer
Dim nbJun As Integer, nbJul As Integer, nbAug As Integer, nbSep As Integer, nbOct As Integer
Dim nbNov As Integer, nbDec As Integer, nbTotal As Integer
Dim sumJan As Long, sumFeb As Long, sumApr As Long, sumMar As Long, sumMay As Long
Dim sumJun As Long, sumJul As Long, sumAug As Long, sumSep As Long, sumOct As Long
Dim sumNov As Long, sumDec As Long, sumTotal As Long
Dim lastlign As Integer
Dim ligTab As Integer
Dim ActualYear As Integer
Dim cursorPerson As Integer
Dim rCell As Range

'store the lenght of the table from "All"
lastlign = Worksheets("All").Range("B" & Rows.Count).End(xlUp).Row

'store the lenght of the table from "Scoring Updater"
ligTab = Worksheets("Scoring Updater").Range("A" & Rows.Count).End(xlUp).Row

nbJan = 0
nbFeb = 0
nbMar = 0
nbApr = 0
nbMay = 0
nbJun = 0
nbJul = 0
nbAug = 0
nbSep = 0
nbOct = 0
nbNov = 0
nbDec = 0
nbTotal = 0

sumJan = 0
sumFeb = 0
sumMar = 0
sumApr = 0
sumMay = 0
sumJun = 0
sumJul = 0
sumAug = 0
sumSep = 0
sumOct = 0
sumNov = 0
sumDec = 0
sumTotal = 0

'store the actual year
ActualYear = Year(Date)
Worksheets("Scoring Updater").Range("A1").Value = ActualYear

cursorPerson = 0

'find and place the number of update per month
j = 4
For Each rCell In Worksheets("Scoring Updater").Range("A4:A" & ligTab)

    For i = 2 To lastlign
        If IsDate(Worksheets("All").Range("G" & i).Value) And IsDate(Worksheets("All").Range("L" & i).Value) Then
            If Year(Worksheets("All").Range("G" & i).Value) = ActualYear Then
                If rCell = Worksheets("All").Range("K" & i).Value Then
                    Select Case Month(Worksheets("All").Range("G" & i).Value)
                    Case 1
                        
                        sumJan = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumJan
                
                        nbJan = nbJan + 1
                        nbTotal = nbTotal + 1
                    Case 2
                        sumFeb = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumFeb
          
                        nbFeb = nbFeb + 1
                        nbTotal = nbTotal + 1
                    Case 3
                        sumMar = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumMar
                       
                        nbMar = nbMar + 1
                        nbTotal = nbTotal + 1
                    Case 4
                        sumApr = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumApr
                   
                        nbApr = nbApr + 1
                        nbTotal = nbTotal + 1
                    Case 5
                        sumMay = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumMay
                     
                        nbMay = nbMay + 1
                        nbTotal = nbTotal + 1
                    Case 6
                        sumJun = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumJun
                     
                        nbJun = nbJun + 1
                        nbTotal = nbTotal + 1
                    Case 7
                        sumJul = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumJul
                       '
                        nbJul = nbJul + 1
                        nbTotal = nbTotal + 1
                    Case 8
                        sumAug = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumAug
                      
                        nbAug = nbAug + 1
                        nbTotal = nbTotal + 1
                    Case 9
                        sumSep = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumSep
                  
                        nbSep = nbSep + 1
                        nbTotal = nbTotal + 1
                    Case 10
                        sumOct = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumOct
                 
                        nbOct = nbOct + 1
                        nbTotal = nbTotal + 1
                    Case 11
                        sumNov = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumNov
                      
                        nbNov = nbNov + 1
                        nbTotal = nbTotal + 1
                    Case 12
                        sumDec = dateDiff("d", Worksheets("All").Range("G" & i), Worksheets("All").Range("L" & i)) + sumDec
                       
                        nbDec = nbDec + 1
                        nbTotal = nbTotal + 1
                    End Select
                End If
            End If
        End If
    Next

    With Worksheets("Scoring Updater")
        If nbJan <> 0 Then
        .Range("B" & 4 + cursorPerson).Value = sumJan / nbJan
        Else: .Range("B" & 4 + cursorPerson).Value = 0
        End If
        .Range("B" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("B" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
       ' .Borders.Weight = xlThin
        .Range("B" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("B" & 4 + cursorPerson) > 7 Then
            .Range("C" & 4 + cursorPerson) = 100 - (((.Range("B" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("B" & 4 + cursorPerson) < 7 Then
            .Range("C" & 4 + cursorPerson) = (((7 - .Range("B" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("B" & 4 + cursorPerson) = 7 Then
            .Range("C" & 4 + cursorPerson) = 100
        End If
        
    End With
    
    
    With Worksheets("Scoring Updater")
    If nbFeb <> 0 Then
        .Range("D" & 4 + cursorPerson).Value = sumFeb / nbFeb
    Else: .Range("D" & 4 + cursorPerson).Value = 0
    End If
        .Range("D" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("D" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
      '  .Borders.Weight = xlThin
        .Range("D" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("D" & 4 + cursorPerson) > 7 Then
            .Range("E" & 4 + cursorPerson) = 100 - (((.Range("D" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("D" & 4 + cursorPerson) < 7 Then
            .Range("E" & 4 + cursorPerson) = (((7 - .Range("J" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("D" & 4 + cursorPerson) = 7 Then
            .Range("E" & 4 + cursorPerson) = 100
        End If
    End With
    
    
    With Worksheets("Scoring Updater")
    If nbMar <> 0 Then
        .Range("F" & 4 + cursorPerson).Value = sumMar / nbMar
    Else: .Range("F" & 4 + cursorPerson).Value = 0
    End If
        .Range("F" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("F" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
       ' .Borders.Weight = xlThin
        .Range("F" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("F" & 4 + cursorPerson) > 7 Then
            .Range("G" & 4 + cursorPerson) = 100 - (((.Range("F" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("F" & 4 + cursorPerson) < 7 Then
            .Range("G" & 4 + cursorPerson) = (((7 - .Range("F" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("F" & 4 + cursorPerson) = 7 Then
            .Range("G" & 4 + cursorPerson) = 100
        End If
    End With
    
    With Worksheets("Scoring Updater")
    If nbApr <> 0 Then
        .Range("H" & 4 + cursorPerson).Value = sumApr / nbApr
    Else: .Range("H" & 4 + cursorPerson).Value = 0
    End If
        .Range("H" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("H" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314

        .Range("H" & 4 + cursorPerson).HorizontalAlignment = xlCenter
         If .Range("H" & 4 + cursorPerson) > 7 Then
            .Range("I" & 4 + cursorPerson) = ((.Range("H" & 4 + cursorPerson) - 7) / 7) * 100
        ElseIf .Range("H" & 4 + cursorPerson) < 7 Then
            .Range("I" & 4 + cursorPerson) = (((7 - .Range("H" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("H" & 4 + cursorPerson) = 7 Then
            .Range("I" & 4 + cursorPerson) = 100
        Else
            .Range("I" & 4 + cursorPerson) = 0
        End If
    End With
    With Worksheets("Scoring Updater")
    If nbMay <> 0 Then
        .Range("J" & 4 + cursorPerson).Value = sumMay / nbMay
    Else: .Range("J" & 4 + cursorPerson).Value = 0
    End If
        .Range("J" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("J" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
     
        .Range("J" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("J" & 4 + cursorPerson) > 7 Then
            .Range("K" & 4 + cursorPerson) = 100 - (((.Range("J" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("J" & 4 + cursorPerson) < 7 Then
            .Range("K" & 4 + cursorPerson) = (((7 - .Range("J" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("J" & 4 + cursorPerson) = 7 Then
            .Range("K" & 4 + cursorPerson) = 100
        End If
    End With
    
    With Worksheets("Scoring Updater")
    If nbJun <> 0 Then
        .Range("L" & 4 + cursorPerson).Value = sumJun / nbJun
    Else: .Range("L" & 4 + cursorPerson).Value = 0
    End If
        .Range("L" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("L" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
    
        .Range("L" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("L" & 4 + cursorPerson) > 7 Then
            .Range("M" & 4 + cursorPerson) = 100 - (((.Range("L" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("L" & 4 + cursorPerson) < 7 Then
            .Range("M" & 4 + cursorPerson) = (((7 - .Range("L" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("L" & 4 + cursorPerson) = 7 Then
            .Range("M" & 4 + cursorPerson) = 100
        End If
    End With
    
    With Worksheets("Scoring Updater")
    If nbJul <> 0 Then
        .Range("N" & 4 + cursorPerson).Value = sumJul / nbJul
    Else: .Range("N" & 4 + cursorPerson).Value = 0
    End If
        .Range("N" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("N" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
       
        .Range("N" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("N" & 4 + cursorPerson) > 7 Then
            .Range("O" & 4 + cursorPerson) = 100 - (((.Range("N" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("N" & 4 + cursorPerson) < 7 Then
            .Range("O" & 4 + cursorPerson) = (((7 - .Range("N" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("N" & 4 + cursorPerson) = 7 Then
            .Range("O" & 4 + cursorPerson) = 100
        End If
    End With
    
    With Worksheets("Scoring Updater")
    If nbAug <> 0 Then
        .Range("P" & 4 + cursorPerson).Value = sumAug / nbAug
    Else: .Range("P" & 4 + cursorPerson).Value = 0
    End If
        .Range("P" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("P" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
     
        .Range("P" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("P" & 4 + cursorPerson) > 7 Then
            .Range("Q" & 4 + cursorPerson) = 100 - (((.Range("P" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("P" & 4 + cursorPerson) < 7 Then
            .Range("Q" & 4 + cursorPerson) = (((7 - .Range("P" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("P" & 4 + cursorPerson) = 7 Then
            .Range("Q" & 4 + cursorPerson) = 100
        End If
    End With
    
    With Worksheets("Scoring Updater")
    If nbSep <> 0 Then
        .Range("R" & 4 + cursorPerson).Value = sumSep / nbSep
    Else
        Range("R" & 4 + cursorPerson).Value = 0
    End If
        .Range("R" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("R" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
  
        .Range("R" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("R" & 4 + cursorPerson) > 7 Then
            .Range("S" & 4 + cursorPerson) = 100 - (((.Range("R" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("R" & 4 + cursorPerson) < 7 Then
            .Range("S" & 4 + cursorPerson) = (((7 - .Range("R" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("R" & 4 + cursorPerson) = 7 Then
            .Range("S" & 4 + cursorPerson) = 100
        End If
    End With
    
    With Worksheets("Scoring Updater")
    If nbOct <> 0 Then
        .Range("T" & 4 + cursorPerson).Value = sumOct / nbOct
    Else
        .Range("T" & 4 + cursorPerson).Value = 0
    End If
        .Range("T" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("T" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
   
        .Range("T" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("T" & 4 + cursorPerson) > 7 Then
            .Range("U" & 4 + cursorPerson) = 100 - (((.Range("T" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("T" & 4 + cursorPerson) < 7 Then
            .Range("U" & 4 + cursorPerson) = (((7 - .Range("T" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("T" & 4 + cursorPerson) = 7 Then
            .Range("U" & 4 + cursorPerson) = 100
        End If
    End With
    
    With Worksheets("Scoring Updater")
        If nbNov <> 0 Then
        .Range("V" & 4 + cursorPerson).Value = sumNov / nbNov
        Else
        .Range("V" & 4 + cursorPerson).Value = 0
        End If
        .Range("V" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("V" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314

        .Range("V" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("V" & 4 + cursorPerson) = 0 Then
            .Range("W" & 4 + cursorPerson) = 0
        End If
    End With
    
    
    
    With Worksheets("Scoring Updater")
    If nbDec <> 0 Then
        .Range("X" & 4 + cursorPerson).Value = sumDec / nbDec
    Else
        .Range("X" & 4 + cursorPerson).Value = 0
    End If
        .Range("X" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("X" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
     
        .Range("X" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        If .Range("X" & 4 + cursorPerson) > 7 Then
            .Range("Y" & 4 + cursorPerson) = 100 - (((.Range("X" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("X" & 4 + cursorPerson) < 7 Then
            .Range("Y" & 4 + cursorPerson) = (((7 - .Range("Y" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("X" & 4 + cursorPerson) = 7 Then
            .Range("Y" & 4 + cursorPerson) = 100
        End If
    End With
    
    
    With Worksheets("Scoring Updater")
        .Range("Z" & 4 + cursorPerson).Value = sumTotal
        .Range("Z" & 4 + cursorPerson).Interior.ThemeColor = xlThemeColorAccent1
        .Range("Z" & 4 + cursorPerson).Interior.TintAndShade = 0.799981688894314
    
        .Range("Z" & 4 + cursorPerson).HorizontalAlignment = xlCenter
        .Range("Z" & 4 + cursorPerson).Font.FontStyle = "Gras"
        If .Range("Z" & 4 + cursorPerson) > 7 Then
            .Range("AA" & 4 + cursorPerson) = 100 - (((.Range("Z" & 4 + cursorPerson) - 7) / 7) * 100)
        ElseIf .Range("Z" & 4 + cursorPerson) < 7 Then
            .Range("AA" & 4 + cursorPerson) = (((7 - .Range("Z" & 4 + cursorPerson)) / 7) * 100 + 100)
        ElseIf .Range("Z" & 4 + cursorPerson) = 7 Then
            .Range("AA" & 4 + cursorPerson) = 100
        End If
       
    End With

sumJan = 0
sumFeb = 0
sumMar = 0
sumApr = 0
sumMay = 0
sumJun = 0
sumJul = 0
sumAug = 0
sumSep = 0
sumOct = 0
sumNov = 0
sumDec = 0
sumTotal = 0
nbJan = 0
nbFeb = 0
nbMar = 0
nbApr = 0
nbMay = 0
nbJun = 0
nbJul = 0
nbAug = 0
nbSep = 0
nbOct = 0
nbNov = 0
nbDec = 0
nbTotal = 0
    
    cursorPerson = cursorPerson + 1
    j = j + 1
Next

 


End Sub







Si vous avez d idées des remarques ou des ameliorations a me proposer je suis prenante et Merci bcp
0
Réponse 2 / 2
thev Messages postés 1960 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 15 février 2025 704
26 août 2016 à 14:33
Bonjour,

Pour pouvoir te répondre, il serait nécessaire de disposer d'un extrait non confidentiel de ton fichier.
Par ailleurs, ton code est sûrement simplifiable via l'utilisation de tableaux.
0
hajars Messages postés 32 Date d'inscription mardi 26 juillet 2016 Statut Membre Dernière intervention 20 septembre 2016
29 août 2016 à 13:03
Bonjour thev,

J ai mis mon fichier en piece jointe
http://www.cjoint.com/c/FHDk6guO5OO

Ca me donnait normalement les score et la moyenne mais mnt ils me donnent erreur je sais pas pourquoi

Il faut regarder sur la feuille scoring updater c est la ou j ai mis le code
y a 3 subs la 1ere pour la presentation la 2eme ca m affiche les updaters sans doublons du tableau All et la 3eme ca fait le scoring et c est la ou il y a une erreur qui vient de se produire.

Quand le delay >7 je suis pas encore sure de la maniere de scoring.

Voila voila
Dis moi s il y a des questions
Merci bcp
0

Discussions similaires

VBA erreur 1004
séverine -
Floroan -

9 réponses
Formule Excel pour afficher les mois (chiffres) en lettre
castelc -
-2-2 -

23 réponses
[excel] erreur 1004 : fichier non enregistré.
nicoa62370 -
gbinforme -

1 réponse
MACRO : Problème " Erreur d'exécution '1004' "
Awazagaga -
Awazagaga -

6 réponses
Code erreur 3000
Laurent -
JM -

5 réponses