Application.ScreenUpdating = False
' supprimer cellules feuille frequence
Sheets("frequence").Select
Sheets("frequence").Range("A2:D4221").Select
Selection.EntireRow.Delete
Sheets("frequence").Range("A1").Select
Sheets("Base de donnée").Select
ActiveSheet.Unprotect
Dim cel As Range
Dim pl As Range
Set pl = Range("A3:A" & Range("A65536").End(xlUp).Row)
pl.Name = "Plg"
Set pl = Range("I3:I" & Range("A65536").End(xlUp).Row)
pl.Name = "LesDates"
Set mondico = CreateObject("Scripting.Dictionary")
For Each cel In [Plg]
If Not mondico.Exists(cel.Value) And cel.Value <> "" Then
mondico.Add cel.Value, cel.Value
End If
Next cel
For Each i In mondico
x = Evaluate("SUMPRODUCT((plg=""" & i & """)*(lesdates>=(DATE(YEAR(MAX(lesdates)),MONTH(MAX(lesdates))-6,DAY(MAX(lesdates))))))")
If x >= 6 Then
With Sheets("frequence")
derlig = .[A65000].End(xlUp).Row + 1
.Cells(derlig, 1).Value = i
.Cells(derlig, 2).Value = x
.Cells(derlig, 3).Value = Date
.Cells(derlig, 4).Value = Time
End With
End If
Next i
Sheets("Base de donnée").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Sheets("frequence").Select
Sheets("frequence").Columns("A:D").Select
ActiveWorkbook.Worksheets("frequence").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("frequence").Sort.SortFields.Add Key:=Range( _
"B2:B42"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("frequence").Sort
.SetRange Range("A1:D42")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("frequence").Range("A1").Select
'RechercheV status des employés
Sheets("frequence").Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],Employés!C1:C2,2,0)"
Selection.AutoFill Destination:=Sheets("frequence").Range("E2:E1423"), Type:=xlFillDefault
Sheets("frequence").Range("E2:E1423").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="Régulier", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Partiel", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Chauffeur", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.SmallScroll Down:=-27
Sheets("frequence").Range("E1").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = 6
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveCell.FormulaR1C1 = "Status"
Sheets("frequence").Range("D1").Select
Selection.Copy
Sheets("frequence").Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("frequence").Columns("A:E").Select
ActiveWorkbook.Worksheets("frequence").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("frequence").Sort.SortFields.Add Key:=Range( _
"E2:E1423"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("frequence").Sort
.SetRange Range("A1:E1423")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("frequence").Range("A1").Select
'Supprimer tous sauf Étudiant
derlig = Sheets("frequence").Range("A200").End(xlUp).Row
For i = 1 To derlig
If Sheets("frequence").Cells(i, 5).Value = "" Then Sheets("frequence").Cells(i, 4).Clear
If Sheets("frequence").Cells(i, 5).Value = "" Then Sheets("frequence").Cells(i, 3).Clear
If Sheets("frequence").Cells(i, 5).Value = "" Then Sheets("frequence").Cells(i, 2).Clear
If Sheets("frequence").Cells(i, 5).Value = "" Then Sheets("frequence").Cells(i, 1).Clear
Next
Application.ScreenUpdating = True