Discussion :

[Paul93]

Bonjour,

Je dois mettre dans un fichier excel des archives papiers. Je voudrais ajouter un ID (Année+numéro incrémenté).
L’incrémentation doit être reprendre pour chaque année. Cependant, on me ramène les documents non classés.
J’ai trouvé le code ci-dessous de Philippe Thulliez. J’avoue que je suis perdu.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Function Counter(LastCount As Long, _
                 Optional LastDate As Date, _
                 Optional PeriodOfChange As String = "C", _
                 Optional WorkDate As Date) As Long
  ' Author : Philippe Tulliez http://philippe.tulliez.be/
  ' Date : 2013-12-18 (first version 2002-05-28)
  ' Version: 3.1
  ' Fonction renvoyant un nombre entier en fonction des arguments suivant :
  ' ... Arguments ... (tous facultatifs sauf le 1er)
  ' LastCount (Long) ' Dernier numéro
  ' [LastDate] (Date) ' Dernière date d'incrémentation du compteur. (Défaut->Date du jour)
  ' [PeriodOfChange] (String) ' Périodicité de reinitialisation du compteur. (Continu par défaut)
  ' (Y) Annuel, (Q) Trimestriel, (M) Mensuel, (W) Hebdomadaire, (D) Jour
  ' [WorkDate] (Date) ' Date de travail. (Date du jour par défaut)
 
  Dim Period As String
  ' Check Arguments
  If LastDate = 0 And Len(PeriodOfChange) = 0 Then Counter = LastCount + 1: Exit Function
  If LastDate = 0 Then LastDate = Date
  If WorkDate = 0 Then WorkDate = Date
  ' Gestion des périodicités (Y)ear, (Q)uarter, (M)onth, (W)eek,(D)ay
  Period = LCase(Left(PeriodOfChange, 1))
  If InStr("yqmwd", Period) = 0 Then Period = "c"
  Select Case Period
    Case "y": Period = "yyyy"
    Case "w": Period = "ww"
  End Select
  Select Case Period
    Case "c": Counter = LastCount + 1
    Case Else: Counter = 1 + LastCount * Abs(DateDiff(Period, LastDate, WorkDate, vbMonday) = 0)
  End Select
End Function

Mon tableau structuré est initialement vide. J’utilise un formulaire pour enregistrer les données.
J’insère la date dans une textbox (TxtDate) et d’autres contrôles.
Le numéro généré par la dite fonction sera stockée dans une cellule nommée « DerNum ».
J’avoue être vraiment perdu. En effet, si par exemple je rempli un certain de de ligne pour par exemple 2021,
ensuite pour 2023 et ensuite d’autres données pour 2021.

Bien que M. Thulliez ait donné des exemples d'utilisation ce fil, j’ai du mal à comprendre l'utilisation de la fonction. Je n'ai que des erreurs.

Au besoin, je peux fournir un fichier vide de donner.

Merci pour votre aide.

[EricDgn]

Oui, ce serait mieux avec de disposer d'un fichier exemple.
Cordialement.

[Paul93]

Bonjour EricDgn,

Désolé pour mon retard. Merci beaucoup pour ton intérêt.
Ci-joint le fichier.

Bonne journée.

Classeur1.xlsmClasseur1.xlsm

[Valtrase]

Bonjour,
Pour la colonne d'identification par index, je pense qu'il faut aller au plus simple avec une incrémentation de 1. Ensuite libre à toi de créer une colonne Numéro de dossier, bien que je trouve cela redondant.
Voici un petit exemple de ce que l'on pourrait faire :

Classeur1.xlsm

[Paul93]

Bonjour,

@Valtrase: Je te remercie beaucoup pour ton fichier. J'ai trouvé plus simple (compter le nombre d’occurrences pour l'année concernée).
Cependant, Je ne sais encore comment transformer une procédure en fonction.
Si tu veux Stp me donner un coup de main dans ce sens.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
Option Compare Text
Dim Tb As ListObject
Dim num As Long, Mondico As Object, Année As Long
 
Private Sub TxtDate_Change()
   On Error Resume Next
   Année = Year(TxtDate)
   Call NumDossier
   TxtNo = Format(CDate(TxtDate), "yyyy") & Format(num, "#000")
   On Error GoTo 0
End Sub
 
Sub NumDossier()
   Dim c As Range
   Set Mondico = CreateObject("Scripting.Dictionary")
   For Each c In Range("TbAnimaux[date]")
      If Year(c.Value) = Année Then
         Mondico(Year(c.Value)) = Mondico(Year(c.Value)) + 1
      End If
   Next c
   If Mondico.Count > 0 Then
      num = Mondico.Item(Année) + 1
     Else
      num = 1
   End If
 Debug.Print num
End Sub

Merci par avance.
Bonne journée.

[EricDgn]

Bonjour,

Une proposition:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub TxtDate_AfterUpdate()
    If Me.TxtDate = "" Then
        ID = ""
        TxtNo = ""
    Else
        ID = Application.Evaluate("=COUNT(TbAnimaux[ID])") + 1
        TxtNo = Year(TxtDate) & "-" & Format(Application.Evaluate("SumProduct(--(Year(TbAnimaux[Date])=" & Year(TxtDate) & "))") + 1, "0000")
    End If
End Sub

Cordialement.

[EricDgn]

Juste pour montrer les possibilités qu'offrent les nouveaux programmes d'intelligence artificielle.

J'ai posé cette question à Mistral

Dans Excel j'ai une plage de données contenant une suite de données telle que celle-ci:
2023-001
2023-002
2024-001
2024-002
2023-003
2023-005
2024-003
2023-006
2024-004
2022-001
2022-002
Quel code VBA permettrait de trouver le dernier numéro utilisé pour une année particulière.
Exemple: pour l'année 2023, le dernier numéro dans la plage est 2023-006.

La réponse obtenue:

Vous pouvez utiliser le code VBA suivant pour trouver le dernier numéro utilisé pour une année particulière dans une plage de données. Ce code suppose que votre plage de données se trouve dans la colonne A à partir de la ligne 1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
```vba
Sub TrouverDernierNumero()
 
    Dim annee As String
    Dim derniereLigne As Long
    Dim i As Long
    Dim dernierNumero As String
 
    ' Définissez l'année que vous voulez vérifier
    annee = "2023"
 
    ' Trouvez la dernière ligne utilisée dans la colonne A
    derniereLigne = Cells(Rows.Count, "A").End(xlUp).Row
 
    ' Initialisez le dernier numéro
    dernierNumero = ""
 
    ' Parcourez chaque cellule dans la plage
    For i = 1 To derniereLigne
        ' Vérifiez si l'année correspond à celle que vous recherchez
        If Left(Cells(i, "A").Value, 4) = annee Then
            ' Vérifiez si le numéro est supérieur au dernier numéro trouvé
            If CInt(Mid(Cells(i, "A").Value, 6, Len(Cells(i, "A").Value))) > CInt(Mid(dernierNumero, 6, Len(dernierNumero))) Then
                ' Mettez à jour le dernier numéro
                dernierNumero = Cells(i, "A").Value
            End If
        End If
    Next i
 
    ' Affichez le dernier numéro trouvé
    MsgBox "Le dernier numéro pour l'année " & annee & " est " & dernierNumero
 
End Sub
```

Ce code parcourt chaque cellule dans la plage, vérifie si l'année correspond à celle que vous recherchez, et si oui, vérifie si le numéro est supérieur au dernier numéro trouvé. Si c'est le cas, il met à jour le dernier numéro. Une fois que toutes les cellules ont été vérifiées, il affiche le dernier numéro trouvé.

Cordialement.

[Paul93]

Bonjour,

Une proposition:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub TxtDate_AfterUpdate()
    If Me.TxtDate = "" Then
        ID = ""
        TxtNo = ""
    Else
        ID = Application.Evaluate("=COUNT(TbAnimaux[ID])") + 1
        TxtNo = Year(TxtDate) & "-" & Format(Application.Evaluate("SumProduct(--(Year(TbAnimaux[Date])=" & Year(TxtDate) & "))") + 1, "0000")
    End If
End Sub

Cordialement.

Bonjour EricDgn,

Je te remercie pour ta proposition. Ton code fonctionne mais plante si on ferme le formulaire (erreur 13).


Stp, c'est quoi Mistral?

Merci.

[EricDgn]

Bonjour,
Bizarre, je n'ai pas cette erreur sur mon pc.
Cordialement.

[Paul93]

Bonjour,

Je te remercie mais ne fonctionne plus comme initialement, le no s'affiche dès qu'on entre une date.
Là, obliger de cliquer dans la textbox no.


En tout cas, je te remercie beaucoup.

[EricDgn]

Comme cela réagit sur _AfterUpdate(), il faut quitter le champ Date pour que cela fonctionne, soit avec Tab, soit avec Entrée, soit clic de souris ailleurs.
Cdt.

[Philippe Tulliez]

Bonjour,

Bien que M. Thulliez ait donné des exemples d'utilisation ce fil, j’ai du mal à comprendre l'utilisation de la fonction. Je n'ai que des erreurs.

La fonction Counter que j'ai publié, n'a qu'un seul but c'est de renvoyer un n° de compteur en fonction d'un ou plusieurs arguments lorsqu'il y a plusieurs arguments on tient compte de la périodicité de réinitialisation du compteur , PeriodOfChange, l'argument et en fonction de la date du jour et de l'argument LastDate (date de la dernière utilisation du compteur) il y aura une remise à 1 ou incrémentation de 1

Ainsi, nous sommes le 6/4/2024 soit #4/6/2024# et dans le code de la procédure t (ci-dessous) le dernier n° utilisé est 5

• Ligne 1 comme on n'utilise que le seul argument obligatoire, le compteur ne se remet jamais à 1
• Ligne 2 la périodicité est annuelle et la dernière utilisation du compteur est le 30/12/2023, la fonction renvoie 1
• Ligne 3 la périodicité est annuelle et la dernière utilisation du compteur est le 6/4/2024, la fonction renvoie 6
• Ligne 4 la périodicité est mensuelle et la dernière utilisation du compteur est le 30/3/2024, la fonction renvoie 1
• Ligne 5 la périodicité est mensuelle et la dernière utilisation du compteur est le 4/4/2024, la fonction renvoie 6

Après utilisation du compteur il faut évidemment écrire une petite procédure qui met à jour le dernier n° de compteur utilisé ainsi que la date du jour.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub t()
  Debug.Print Counter(LastCount:=5)                                              ' Renvoie 6
  ' Exemple de l'initialisation (Y) Annuelle
  Debug.Print Counter(LastCount:=5, LastDate:=#12/30/2023#, PeriodOfChange:="Y") ' Renvoie 1
  Debug.Print Counter(LastCount:=5, LastDate:=#4/6/2024#, PeriodOfChange:="Y")   ' Renvoie 6
  ' Exemple de l'initialisation (M) Mensuelle
  Debug.Print Counter(LastCount:=5, LastDate:=#3/30/2024#, PeriodOfChange:="M")  ' Renvoie 1
  Debug.Print Counter(LastCount:=5, LastDate:=#4/4/2024#, PeriodOfChange:="M")   ' Renvoie 6
End Sub

J'espère que ces explications sont plus claires