VBA gestion de dates

Le 17/10/2019 à 14:50

Bonjour à Tous,

Tous les lundis, je reçois pour mon travail le fichier Excel ci-joint (gestion de toners pour photocopieurs).

La colonne D contient des dates au format JJ/MM/AAAA : HH:MN

Chaque lundi, je dois épurer cette liste en appliquant les tâches suivantes :

1/ Ne conserver que les lignes dont la date en colonne D est comprise entre une date de début et une date de fin.

2/ Appliquer ensuite une fonction pour supprimer les doublons sur les numéros de série des machines (colonne A)

Pour la 1ère partie, je me suis servi d'une macro trouvée sur Excel-pratique que j'ai adapté à mon cas.

Cette macro :

1/ Reformate la colonne D pour ne conserver que la date (on enlève l'heure)

2/ Supprime les lignes dont la date n'est pas comprise dans l'intervalle renseigné.

3/ Tri les dates filtrés par ancienneté

J'aurais souhaité svp ajouter à cette macro (ou à la limite en créer une autre) de quoi pouvoir supprimer toutes les lignes en double, triple, ou plus !...

J'avoue que pour cette partie, je peine...

MERCI BEAUCOUP !

10macro-dates.txt (716.00 Octets)
8toners-vides.xlsx (23.65 Ko)
Le 17/10/2019 à 15:03

Bonjour,

Pour l'instant, les actions que vous décrivez sont facilement réalisables directement dans Excel, sans recourir aux macros.

Par ailleurs, votre code actuel présente plusieurs défauts, et notamment celui de ne pas retirer les heures (elle ne fait que les masquer)...

Je planche sur un code.

Le 17/10/2019 à 15:18

Bonjour Pedro22 et merci de votre aide

Cordialement,

Le 17/10/2019 à 15:37

Voilà une proposition à tester :

Sub DateFilter()

'Déclaration des variables (toujours groupées au début)
Dim i As Long, NbLig As Long, Annee As Integer, Mois As Integer, Jour As Integer, DateDebut As Date, DateFin As Date

Application.Calculation = xlCalculationManual 'Désactive le recalcul auto des formules Excel (vitesse ++)

With Sheets("NomFeuille") 'Nom à adapter
    'Dernière ligne
    NbLig = .Range("D" & .Rows.Count).End(xlUp).Row

    'Demande la date de début (saisie par étape : limite le risque d'erreur)
    Annee = Application.InputBox("Année :", "Date de début", Year(Date), Type:=1)
    Mois = Application.InputBox("Mois :", "Date de début", Month(Date), Type:=1)
    Jour = Application.InputBox("Jour :", "Date de début", Day(Date), Type:=1)
    DateDebut = DateSerial(Annee, Mois, Jour)

    'Demande la date de fin
    Annee = Application.InputBox("Année :", "Date de fin", Year(Date), Type:=1)
    Mois = Application.InputBox("Mois :", "Date de fin", Month(Date), Type:=1)
    Jour = Application.InputBox("Jour :", "Date de fin", Day(Date), Type:=1)
    DateFin = DateSerial(Annee, Mois, Jour)

    'Affiche le choix des dates
    MsgBox "Votre choix: de " & DateDebut & " à " & DateFin & ""

    'Retire la partie horaire des dates
    For i = 1 To NbLig
        .Cells(i, 4) = Int(.Cells(i, 4)) 'Retire les décimales (= l'heure)
        .Cells(i, 4).NumberFormat = "m/d/yyyy" 'Reformate la date
    Next i

    'Suppression des lignes hors période
    If .FilterMode = True Then .ShowAllData 'Retire les éventuels anciens filtres
    .Range("A1:X" & NbLig).AutoFilter Field:=4, Criteria1:="<=" & DateDebut, Operator:=xlOr, Criteria2:=">=" & DateFin 'Filtre sur les dates hors période, à adapter : "X" --> lettre de la dernière colonne du tableau
    .Rows("1:" & NbLig).SpecialCells(xlCellTypeVisible).Delete 'Suppression des lignes filtrées
    .Range("A1:X" & NbLig).AutoFilter Field:=4 'Retire le filtre

    'Dernière ligne (après supression de lignes)
    NbLig = .Range("D" & .Rows.Count).End(xlUp).Row

    'Tri par date croissante
    .AutoFilter.Sort.SortFields.Clear
    .AutoFilter.Sort.SortFields.Add Key:=Range("D1:D" & NbLig), SortOn:=xlSortOnValues, Order:=xlAscending
    With .AutoFilter.Sort
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

   'Suppression des doublons
   .Range("A1:X" & NbLig).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 'A adapter : "X" --> lettre de la dernière colonne du tableau ; Array(1,2) liste des n° de colonne sur lesquelles déterminer les doublons
End With

Application.Calculation = xlCalculationAutomatic

End Sub

Attention, tout est écrit pour un fichier qui ne comporte pas de ligne d'en-tête !

Si besoin de compléments : https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.removeduplicates

Le 17/10/2019 à 15:52

Je suis désolé, j'ai un message d'erreur à l'exécution du code sur cette ligne :

.Cells(i, 4) = Int(.Cells(i, 4)) ' Retire les décimales (=l'heure)

Le 17/10/2019 à 17:21
grandid a écrit :

Je suis désolé, j'ai un message d'erreur à l'exécution du code sur cette ligne :

.Cells(i, 4) = Int(.Cells(i, 4)) ' Retire les décimales (=l'heure)

C'est probablement que la cellule ne contient pas de nombre (ou un nombre qui n'est pas reconnu comme tel).

Regarde à quelle ligne elle se produit en passant ta souris sur la variable i dans l'éditeur VBA, en mode débogage.

Tu peux toujours écrire une vérification avant d’exécuter cette ligne :

If IsNumeric(.Cells(i, 4)) Then .Cells(i, 4) = Int(.Cells(i, 4)) ' Retire les décimales (=l'heure)

PS : une date valide est un nombre, avec un affichage particulier (format date).

Le 17/10/2019 à 17:26

(suite)

Pedro22 a écrit :

Attention, tout est écrit pour un fichier qui ne comporte pas de ligne d'en-tête !

Après vérification, ton fichier comporte une en-tête. Voilà donc le code révisé pour en tenir compte :

Sub DateFilter()

'Déclaration des variables (toujours groupées au début)
Dim i As Long, NbLig As Long, Annee As Integer, Mois As Integer, Jour As Integer, DateDebut As Date, DateFin As Date

Application.Calculation = xlCalculationManual 'Désactive le recalcul auto des formules Excel (vitesse ++)

With Sheets("NomFeuille") 'Nom à adapter
    'Dernière ligne
    NbLig = .Range("D" & .Rows.Count).End(xlUp).Row

    'Demande la date de début (saisie par étape : limite le risque d'erreur)
    Annee = Application.InputBox("Année :", "Date de début", Year(Date), Type:=1)
    Mois = Application.InputBox("Mois :", "Date de début", Month(Date), Type:=1)
    Jour = Application.InputBox("Jour :", "Date de début", Day(Date), Type:=1)
    DateDebut = DateSerial(Annee, Mois, Jour)

    'Demande la date de fin
    Annee = Application.InputBox("Année :", "Date de fin", Year(Date), Type:=1)
    Mois = Application.InputBox("Mois :", "Date de fin", Month(Date), Type:=1)
    Jour = Application.InputBox("Jour :", "Date de fin", Day(Date), Type:=1)
    DateFin = DateSerial(Annee, Mois, Jour)

    'Affiche le choix des dates
    MsgBox "Votre choix: de " & DateDebut & " à " & DateFin & ""

    'Retire la partie horaire des dates
    For i = 2 To NbLig
        If IsNumeric(.Cells(i, 4)) Then .Cells(i, 4) = Int(.Cells(i, 4)) 'Retire les décimales (= l'heure)
        .Cells(i, 4).NumberFormat = "m/d/yyyy" 'Reformate la date
    Next i

    'Suppression des lignes hors période
    If .FilterMode = True Then .ShowAllData 'Retire les éventuels anciens filtres
    .Range("A1:X" & NbLig).AutoFilter Field:=4, Criteria1:="<=" & DateDebut, Operator:=xlOr, Criteria2:=">=" & DateFin 'Filtre sur les dates hors période, à adapter : "X" --> lettre de la dernière colonne du tableau
    .Rows("2:" & NbLig).SpecialCells(xlCellTypeVisible).Delete 'Suppression des lignes filtrées
    .Range("A1:X" & NbLig).AutoFilter Field:=4 'Retire le filtre

    'Dernière ligne (après supression de lignes)
    NbLig = .Range("D" & .Rows.Count).End(xlUp).Row

    'Tri par date croissante
    .AutoFilter.Sort.SortFields.Clear
    .AutoFilter.Sort.SortFields.Add Key:=Range("D1:D" & NbLig), SortOn:=xlSortOnValues, Order:=xlAscending
    With .AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

   'Suppression des doublons
   .Range("A1:X" & NbLig).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes 'A adapter : "X" --> lettre de la dernière colonne du tableau ; Array(1,2) liste des n° de colonne sur lesquelles déterminer les doublons
End With

Application.Calculation = xlCalculationAutomatic

End Sub
Le 17/10/2019 à 17:30

Oui merci !

C'est exactement ce que je pensais.

On doit commencer le traitement à partir de la ligne 2

Rechercher des sujets similaires à "vba gestion dates"