Extraction sans doublons date

Bonjour Vicolemino, Bonjour Albkan
Voici les explications en commentaires,
Pour comprendre le raisonnement, je suis parti des données fournies dans le sujet initial, Ma première réponse ne convenant pas parfaitement parce que suivant vos dires "dans mon tableau complet, elle n'enlève pas tous les doublons, le remplissage ne doit pas être uniformisé", j'en ai donc tenu compte dans le dernier envoi en retraitant la colonne des dates afin quelles soient toutes uniformisées et éviter ainsi tout plantage futur. Ensuite j'ai crée une zone de nom pour la colonne "PPS 8D Date" que je détruit et recrée à chaque fois pour l'adapter à la nouvelle longueur du tableau. Ensuite à l'aide d'un filtre avancé, les dates sans doublons sont recopiées sur la 2ème feuille, et la aussi, je recrée les formules de comptage pour les adapter à la longueur du nouveau tableau.

Sub ExtractionSansDoublons()
    Dim DerCol As Integer, DerLig As Integer
    Application.ScreenUpdating = False
    Sheets("Tableau 2").Range("A3:A" & [A3].End(xlDown).Row).ClearContents
    Sheets("Tableau 1").Select
    ActiveWorkbook.Names("PPS8dDate").Delete 'Détruit la zone de nom "PPS8dDate" pour en créer une nouvelle adaptée à la longueur de la liste
    ActiveWorkbook.Names.Add Name:="PPS8dDate", RefersToR1C1:=Range("E1:E" & [E10000].End(xlUp).Row) 'création de la nouvelle zone de nom "PPS8dDate"
    DerCol = Range("A1").SpecialCells(xlCellTypeLastCell).Column 'on repère la dernière cellule du tableau
    Cells(1, DerCol) = 1 'Dans une cellule vide je met la valeur 1 que je copie
    Cells(1, DerCol).Copy
    Range("E1:E" & [E10000].End(xlUp).Row).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply 'on fait un collage spécial multiplication, ce qui à pour effet de mettre toutes les dates au même format
    Sheets("Tableau 2").Select
    Range("A2:A3").Select
    Range("PPS8dDate").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A2"), Unique:=True 'on va sur la feuille "Tableau 2" et on applique le filtre avancé
    Range("C3:C" & [A10000].End(xlUp).Row).FormulaR1C1 = "=IF(RC[-2]=0,"""",COUNTIF('Tableau 1'!R2C5:R19C5,'Tableau 2'!RC[-2]))" 'on recrée les formiules d'extraction du nombre de personnes formées
    Sheets("Tableau 1").Cells(1, DerCol).ClearContents ' on revient sur la feuille "TAbleau 1" pour effacer le 1 qui ne sert plus
End Sub

Cordialement

Bonjour Vicolemino,

Le nombre 42327 est le N° de Série de la date 19/11/2015. C'est normal,
et tu le vois ainsi car le format de ta cellule est le format Standard.

Pour voir la date 19/11/2015 à la place de ce N° de Série, tu dois mettre le format
"jj/mm/aaaa" ; et tu peux aussi mettre tout autre format de date qui te convient.

Cordialement.  😊
 

Bonjour albkan,

j'ai vu ça oui et du coup j'ai réussis à contourner le problème. Cependant je me retrouve face à une nouvelle difficulté. Je veux trier ces dates par ordre croissant. N'ayant pas réussi à réaliser un tri correct en laissant les cellules au format date, je travaille avec un format nombre et je finis par remettre un format date en toute fin de macro. Le problème que je rencontre est que le tri s'emmêle lorsque je repasse au format date. Ci-joint le code que j'ai réalisé (en me servant beaucoup de la première version de frenchie :) ) (je ne sais pas comment ajouter le code tel que vous l'avez fait plus haut...):

Sub Macro2()
Application.ScreenUpdating = False
'On indique que les calculs ne seront pas affichés à l'écran

With Range("Y17:Y200")
.ClearContents
End With
'On efface les données présentes dans la colonne Y à partir de la ligne 17

With Range("A23:A200")
.ClearContents
End With
'On efface les données présentes dans la colonne A à partir de la ligne 23


Range("PPS8dDate").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Y17"), Unique:=True
' On extrait les valeurs de la colonne PPS8dDate sans doublons. (Unique=True signifie sans doublons)
' Pour garder les doublons, on écrit Unique= False

For Each cellule In Sheets("résumé").Range("Y17:Y200")
cellule.Value = Format(cellule.Value, "#.00")
Next cellule

x = 17
While Cells(x, 25) <> ""
If Cells(x, 25) <= 42370 Then
Cells(x, 25).Delete
x = x - 1
End If
x = x + 1
Wend
' On supprime les dates inférieures à 42370= 01/01/2016 en chiffre
' Si l'on souhaite changer la date, il faut regarder sa valeur en l'écrivant dans une case
' et en changeant le format sur "nombre"


Sheets("résumé").Select
Range("Y17:Y200").Copy
Range("A23").Select
ActiveSheet.Paste
'On copie-colle les valeur présentent dans la colonne Y à partir de la ligne 17
'dans le tableau PPS 8D date

With Worksheets("résumé")
.AutoFilterMode = False
.Range("A23:A200").AutoFilter
End With
Range("A23:A200").Sort Key1:=Range("A23"), Order1:=xlAscending, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal



Range("A23:A10000").HorizontalAlignment = xlCenter
Sheets("NEW").Range("E2:E10000").HorizontalAlignment = xlCenter
' On centre horizontalement les valeurs des cellules précédement définies au format date

For Each cellule In Sheets("NEW").Range("E2:E1500")
cellule.Value = Format(cellule.Value, "dd/mm/yyyy")
Next cellule
' On repasse les valeurs en format date


'For Each cellule In Sheets("résumé").Range("A23:A200")
'cellule.Value = Format(cellule.Value, "dd/mm/yyyy")
'Next cellule
'On repasse les valeurs en format date


Range("C23:C" & [A10000].End(xlUp).Row).FormulaR1C1 = "=IF(RC[-2]=0,"""",COUNTIF('NEW'!R2C5:R5000C5,'résumé'!RC[-2]))"
'on recrée les formiules d'extraction du nombre de personnes formées

With Range("Y17:Y200")
.ClearContents
End With
'On efface les données présentes dans la colonne Y à partir de la ligne 17
Application.ScreenUpdating = True
'On raffiche les résultat à l'écran

End Sub


Vois-tu une erreur dedans qui expliquerait ce problème ?

Je te remercie et te souhaite une bonne soirée !!

Victor